| 1 | IBDF18A2 ;WISC/TN - ENCOUNTER FORM - utilities for PCE ;30-APR-03
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**51,55**;APR 30, 2003
|
|---|
| 3 | ;
|
|---|
| 4 | QUIT ;CAll at CHKLST
|
|---|
| 5 | ;
|
|---|
| 6 | CHKLST ;Create a new list to pass to calling packages.
|
|---|
| 7 | ;The new array will have CPT or ICD codes which
|
|---|
| 8 | ;are valid for the encounter date passed.
|
|---|
| 9 | ;
|
|---|
| 10 | ;CALLED BY: IBDF18A
|
|---|
| 11 | ;
|
|---|
| 12 | ;Quit if no date is passed.
|
|---|
| 13 | S ENCDATE=$G(ENCDATE) I ENCDATE="" Q
|
|---|
| 14 | ;
|
|---|
| 15 | NEW AA,CNT,CNT1,CNT2,MOD,TYPE,NODE
|
|---|
| 16 | K ^TMP("IBDCSV",$J)
|
|---|
| 17 | ;
|
|---|
| 18 | S CNT=0,AA=0,TYPE="",NODE="MODIFIER"
|
|---|
| 19 | S:PACKAGE="DG SELECT CPT PROCEDURE CODES" TYPE="CPT"
|
|---|
| 20 | S:PACKAGE="DG SELECT ICD-9 DIAGNOSIS CODE" TYPE="ICD"
|
|---|
| 21 | S:PACKAGE="DG SELECT VISIT TYPE CPT PROCE" TYPE="CPT"
|
|---|
| 22 | S:PACKAGE="GMP INPUT CLINIC COMMON PROBLE" TYPE="ICD"
|
|---|
| 23 | S:PACKAGE="GMP PATIENT ACTIVE PROBLEMS" TYPE="ICD"
|
|---|
| 24 | ;
|
|---|
| 25 | I TYPE="" D Q
|
|---|
| 26 | . K @ARY
|
|---|
| 27 | . S @ARY@(0)=1
|
|---|
| 28 | . S @ARY@(1)="^AICS ERROR - Missing code type for "_PACKAGE
|
|---|
| 29 | ;
|
|---|
| 30 | ;Make copy of arry and kill the original
|
|---|
| 31 | M ^TMP("IBDCSV",$J)=@ARY KILL @ARY
|
|---|
| 32 | ;
|
|---|
| 33 | S CNT=0,AA=0
|
|---|
| 34 | F S AA=$O(^TMP("IBDCSV",$J,AA)) Q:'AA D
|
|---|
| 35 | . ;
|
|---|
| 36 | . I $E(^TMP("IBDCSV",$J,AA))="^" S CNT=CNT+1,@ARY@(CNT)=^TMP("IBDCSV",$J,AA) Q ;header
|
|---|
| 37 | . ;
|
|---|
| 38 | . S CODE=$P(^TMP("IBDCSV",$J,AA),U) I CODE="" Q
|
|---|
| 39 | . ;
|
|---|
| 40 | . ;Validate the CPT code for the date passed
|
|---|
| 41 | . I TYPE="CPT" D Q
|
|---|
| 42 | . . I $P($$CPT^ICPTCOD(CODE,ENCDATE),U,7)=1 D
|
|---|
| 43 | . . . S CNT=CNT+1,@ARY@(CNT)=^TMP("IBDCSV",$J,AA)
|
|---|
| 44 | . . . ;
|
|---|
| 45 | . . . ;Check for modifiers.
|
|---|
| 46 | . . . I '$G(^TMP("IBDCSV",$J,AA,NODE,0)) Q
|
|---|
| 47 | . . . ;
|
|---|
| 48 | . . . S CNT1=^TMP("IBDCSV",$J,AA,NODE,0)
|
|---|
| 49 | . . . F CNT2=1:1:CNT1 S MOD=^TMP("IBDCSV",$J,AA,NODE,CNT2) D
|
|---|
| 50 | . . . . ;
|
|---|
| 51 | . . . . ;If the status is 1 for the modifier
|
|---|
| 52 | . . . . I $P($$MOD^ICPTMOD(MOD,"E",ENCDATE),U,7)=1 D
|
|---|
| 53 | . . . . . S @ARY@(CNT,NODE,CNT2)=^TMP("IBDCSV",$J,AA,NODE,CNT2)
|
|---|
| 54 | . . . . . S @ARY@(CNT,NODE,0)=CNT2
|
|---|
| 55 | . . . . ;
|
|---|
| 56 | . ;Validate the ICD code for the date passed
|
|---|
| 57 | . I $P($$ICDDX^ICDCODE(CODE,ENCDATE),U,10)=1 D
|
|---|
| 58 | . . S CNT=CNT+1,@ARY@(CNT)=^TMP("IBDCSV",$J,AA)
|
|---|
| 59 | ;
|
|---|
| 60 | S @ARY@(0)=CNT
|
|---|
| 61 | K ^TMP("IBDCSV",$J)
|
|---|
| 62 | Q
|
|---|
