63 lines
1.9 KiB
Mathematica
63 lines
1.9 KiB
Mathematica
IBDF18A2 ;WISC/TN - ENCOUNTER FORM - utilities for PCE ;30-APR-03
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;**51,55**;APR 30, 2003
|
|
;
|
|
QUIT ;CAll at CHKLST
|
|
;
|
|
CHKLST ;Create a new list to pass to calling packages.
|
|
;The new array will have CPT or ICD codes which
|
|
;are valid for the encounter date passed.
|
|
;
|
|
;CALLED BY: IBDF18A
|
|
;
|
|
;Quit if no date is passed.
|
|
S ENCDATE=$G(ENCDATE) I ENCDATE="" Q
|
|
;
|
|
NEW AA,CNT,CNT1,CNT2,MOD,TYPE,NODE
|
|
K ^TMP("IBDCSV",$J)
|
|
;
|
|
S CNT=0,AA=0,TYPE="",NODE="MODIFIER"
|
|
S:PACKAGE="DG SELECT CPT PROCEDURE CODES" TYPE="CPT"
|
|
S:PACKAGE="DG SELECT ICD-9 DIAGNOSIS CODE" TYPE="ICD"
|
|
S:PACKAGE="DG SELECT VISIT TYPE CPT PROCE" TYPE="CPT"
|
|
S:PACKAGE="GMP INPUT CLINIC COMMON PROBLE" TYPE="ICD"
|
|
S:PACKAGE="GMP PATIENT ACTIVE PROBLEMS" TYPE="ICD"
|
|
;
|
|
I TYPE="" D Q
|
|
. K @ARY
|
|
. S @ARY@(0)=1
|
|
. S @ARY@(1)="^AICS ERROR - Missing code type for "_PACKAGE
|
|
;
|
|
;Make copy of arry and kill the original
|
|
M ^TMP("IBDCSV",$J)=@ARY KILL @ARY
|
|
;
|
|
S CNT=0,AA=0
|
|
F S AA=$O(^TMP("IBDCSV",$J,AA)) Q:'AA D
|
|
. ;
|
|
. I $E(^TMP("IBDCSV",$J,AA))="^" S CNT=CNT+1,@ARY@(CNT)=^TMP("IBDCSV",$J,AA) Q ;header
|
|
. ;
|
|
. S CODE=$P(^TMP("IBDCSV",$J,AA),U) I CODE="" Q
|
|
. ;
|
|
. ;Validate the CPT code for the date passed
|
|
. I TYPE="CPT" D Q
|
|
. . I $P($$CPT^ICPTCOD(CODE,ENCDATE),U,7)=1 D
|
|
. . . S CNT=CNT+1,@ARY@(CNT)=^TMP("IBDCSV",$J,AA)
|
|
. . . ;
|
|
. . . ;Check for modifiers.
|
|
. . . I '$G(^TMP("IBDCSV",$J,AA,NODE,0)) Q
|
|
. . . ;
|
|
. . . S CNT1=^TMP("IBDCSV",$J,AA,NODE,0)
|
|
. . . F CNT2=1:1:CNT1 S MOD=^TMP("IBDCSV",$J,AA,NODE,CNT2) D
|
|
. . . . ;
|
|
. . . . ;If the status is 1 for the modifier
|
|
. . . . I $P($$MOD^ICPTMOD(MOD,"E",ENCDATE),U,7)=1 D
|
|
. . . . . S @ARY@(CNT,NODE,CNT2)=^TMP("IBDCSV",$J,AA,NODE,CNT2)
|
|
. . . . . S @ARY@(CNT,NODE,0)=CNT2
|
|
. . . . ;
|
|
. ;Validate the ICD code for the date passed
|
|
. I $P($$ICDDX^ICDCODE(CODE,ENCDATE),U,10)=1 D
|
|
. . S CNT=CNT+1,@ARY@(CNT)=^TMP("IBDCSV",$J,AA)
|
|
;
|
|
S @ARY@(0)=CNT
|
|
K ^TMP("IBDCSV",$J)
|
|
Q
|