source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN14.m@ 1608

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1IBDFN14 ;ALB/CMR - ENCOUNTER FORM - OUTPUTS;JAN 4, 1996
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,51**;APR 24, 1997
3 ;
4CPT(X) ; -- return external value, descr and active flag for CPT code
5 ; -- X passed equal to ien for cpt code
6 ;
7 ; input: ien of file #81
8 ; output: IBID = cpt code (.01 field of file #81)
9 ; IBLABEL = description fo cpt code
10 ; IBINACT = null if active
11 ; 1 if inactive
12 ;
13 Q:'X
14 N IBDFNODE
15 S (IBID,IBLABEL,IBINACT)=""
16 S IBDFNODE=$$CPT^ICPTCOD(X)
17 Q:+IBDFNODE=-1
18 S IBID=$P(IBDFNODE,"^",2)
19 S IBLABEL=$P(IBDFNODE,"^",3)
20 S IBINACT=$S($P(IBDFNODE,"^",7)=1:"",1:1)
21 Q
22DX(X) ; -- return external value, descr and active flag for ICD9 diagnosis
23 ; -- pass X equal to ien for icd9 code
24 ;
25 Q:'X
26 N ICDNODE
27 S (IBID,IBLABEL,IBINACT)=""
28 ;;I $G(^ICD9(X,0))]"" S IBID=$P(^(0),"^"),IBLABEL=$P(^(0),"^",3),IBINACT=$P(^(0),"^",9)
29 S ICDNODE=$$ICDDX^ICDCODE(X)
30 Q:+ICDNODE=-1
31 S IBID=$P(ICDNODE,U,2) ;ICD code
32 S IBLABEL=$P(ICDNODE,U,4) ;ICD description
33 S STATUS=$P(ICDNODE,U,10) ;ICD status, 0-Not Active, 1-Acitve
34 ;
35 ;Set inactive flag to 1, if the ICD code is not active (STATUS=0)
36 I STATUS=0 S IBINACT=1
37 Q
38VST(X) ; -- return external value, descr and active flag for VISIT TYPE
39 ; -- pass X equal to ien for visit type
40 ;
41 Q:'X
42 S (IBID,IBLABEL,IBINACT)=""
43 ;; --change to api cpt ; dhh
44 I $G(^IBE(357.69,X,0))]"",+$$CPT^ICPTCOD(X)'=-1 D
45 .S IBID=$P(^IBE(357.69,X,0),"^"),IBLABEL=$P(^(0),"^",3)
46 .S HDR=$P(^IBE(357.69,X,0),"^",2) I $L(HDR_IBLABEL)<75 S IBLABEL=HDR_" "_IBLABEL
47 .K HDR
48 .;; --change to api cpt ; dhh
49 .S IBINACT=$S($P(^IBE(357.69,X,0),"^",4):1,$P($$CPT^ICPTCOD(X),"^",7)=0:1,1:"")
50 Q
51ED(X) ; -- return descr and active flag for education topics
52 ; -- pass X equal to ien for education topic
53 ;
54 Q:'X
55 S (IBID,IBLABEL,IBINACT)=""
56 I $G(^AUTTEDT(X,0))]"" S IBID="ED TOPIC",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",3)
57 Q
58EXAM(X) ; -- return descr and active flag for exam
59 ; -- pass X equal to ien for exam
60 ;
61 Q:'X
62 S (IBID,IBLABEL,IBINACT)=""
63 I $G(^AUTTEXAM(X,0))]"" S IBID="EXAM",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",4)
64 Q
65HF(X) ; -- return descr and active flag for health factor
66 ; -- pass X equal to ien for health factor
67 ;
68 Q:'X
69 S (IBID,IBLABEL,IBINACT)=""
70 I $G(^AUTTHF(X,0))]"" S IBID="FACTOR",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",11)
71 Q
72 ;
73IMMUN(X) ; -- return descr and active flag for immunization
74 ; -- pass X equal to ien for immunization
75 ;
76 Q:'X
77 S (IBID,IBLABEL,IBINACT)=""
78 I $G(^AUTTIMM(X,0))]"" S IBID="IMMUN",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",7)
79 Q
80 ;
81TREAT(X) ; -- return descr and active flag for treatment
82 ; -- pass X equal to ien for TREATMENTS
83 ;
84 Q:'X
85 S (IBID,IBLABEL,IBINACT)=""
86 I $G(^AUTTTRT(X,0))]"" S IBID="TREATMENT",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",4)
87 Q
88 ;
89ST(X) ; -- return descr and active flag for immunization
90 ; -- pass X equal to ien for immunization
91 ;
92 Q:'X
93 S (IBID,IBLABEL,IBINACT)=""
94 I $G(^AUTTSK(X,0))]"" S IBID="SKIN TEST",IBLABEL=$P(^(0),"^"),IBINACT=$P(^(0),"^",3)
95 Q
96YN(X) ; -- return descr
97 ; -- pass X equal to 1 or 0
98 ;
99 Q:X']""
100 S IBID="VALUE"
101 S (IBLABEL,IBINACT)=""
102 I X S IBLABEL="YES" Q
103 S IBLABEL="NO" Q
104 Q
Note: See TracBrowser for help on using the repository browser.