source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF18A2.m@ 1375

Last change on this file since 1375 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1IBDF18A2 ;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 ;
6CHKLST ;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
Note: See TracBrowser for help on using the repository browser.