source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN12.m@ 1696

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

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1IBDFN12 ;ALB/CJM - ENCOUNTER FORM - SELECTORS;MAY 10, 1995
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**12,38,40,51**;APR 24, 1997
3 ;
4LOOKUP(FILE,SCREEN,X,NODE) ;
5 ; -- lookup X in file using SCREEN
6 ; -- kills X if lookup not successful, else sets X to the ien and returns NODE as the 0 node
7 ; -- pass X and NODE by reference
8 ;
9 I +$G(FILE)<1 K X Q
10 N Y
11 S (NODE,Y)=""
12 K DIC S DIC=FILE,DIC("S")=SCREEN
13 S DIC(0)="EMQZ"
14 I $D(^DIC(FILE)) D ^DIC K DIC
15 I +Y>0 D
16 .S X=Y,NODE=Y(0)
17 E K X
18 Q
19 ;
20SLCTCPT(X) ;for CPT codes
21 ;pass X by reference
22 ;example of use: D SLCTCPT^IBDFN12(.X)
23 ;
24 N NODE,SCRN
25 ;;D LOOKUP(81,"I '$P(^(0),U,4)",.X,.NODE)
26 ;
27 ;List only active code. (CSV)
28 S SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;Check status for CPT (CSV)
29 D LOOKUP(81,SCRN,.X,.NODE)
30 I $D(X) S IBLABEL=$P(NODE,"^",2),(IBID,X)=$P(NODE,"^",1)
31 Q
32 ;
33SLCTDX(X) ;for ICD9 diagnosis codes
34 ;pass X by reference
35 ;example of use: D SLCTICD^IBDFN12(.X)
36 ;
37 N NODE,SCRN
38 ;;D LOOKUP(80,"I '$P(^(0),U,9)",.X,.NODE)
39 ;
40 ;List only active code. (CSV)
41 S SCRN="I $P($$ICDDX^ICDCODE(Y),U,10)=1" ;Check status for ICD (CSV)
42 D LOOKUP(80,SCRN,.X,.NODE)
43 I $D(X) S IBLABEL=$P(NODE,"^",3),(IBID,X)=$P(NODE,"^",1)
44 Q
45 ;
46SLCTVST(X) ;for VISIT TYPE codes
47 ;pass X by reference
48 ;example of use: D SLCTVST^IBDFN12(.X)
49 ;
50 N NODE,SCREEN
51 ;;D LOOKUP(357.69,"I '$P(^(0),U,4)",.X,.NODE)
52 ;
53 ;List only active code. (CSV)
54 S SCRN="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;Check status for CPT (CSV)
55 D LOOKUP(357.69,SCRN,.X,.NODE)
56 ;
57 ;; --change to api cpt ; dhh
58 I $G(X) S NODE=$$CPT^ICPTCOD(+NODE),NODE=$G(NODE),(IBID,X)=$P(NODE,"^",2),IBLABEL=$P(NODE,"^",3)
59 Q
60 ;
61SLCTED(X) ;for Education Topics
62 ;pass X by reference
63 ;example of use: D SLCTED^IBDFN12(.X)
64 ;
65 N NODE
66 D LOOKUP(9999999.09,"",.X,.NODE)
67 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
68 Q
69 ;
70SLCTIMM(X) ;for Immunizations
71 ;pass X by reference
72 ;example of use: D SLCTIMM^IBDFN12(.X)
73 ;
74 N NODE
75 D LOOKUP(9999999.14,"",.X,.NODE)
76 I $D(X) S IBLABEL=$P(NODE,"^",2),IBID=+X,X=IBLABEL
77 Q
78 ;
79SLCTEX(X) ;for Exams
80 ;pass X by reference
81 ;example of use: D SLCTEX^IBDFN12(.X)
82 ;
83 N NODE
84 D LOOKUP(9999999.15,"",.X,.NODE)
85 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
86 Q
87 ;
88SLCTSKN(X) ;for Skin Tests
89 ;pass X by reference
90 ;example of use: D SLCTSKN^IBDFN12(.X)
91 ;
92 N NODE
93 D LOOKUP(9999999.28,"",.X,.NODE)
94 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
95 Q
96 ;
97SLCTHF(X) ;for Health Factors
98 ;pass X by reference
99 ;example of use: D SLCTHF^IBDFN12(.X)
100 ;
101 N NODE
102 D LOOKUP(9999999.64,"I $P(^(0),U,10)=""F"",'$P(^(0),U,11)",.X,.NODE)
103 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
104 Q
105SLCTTR(X) ;for Treatments
106 ;pass X by reference
107 ;example of use: D SLCTTR^IBDFN12(.X)
108 ;
109 N NODE
110 D LOOKUP(9999999.17,"",.X,.NODE)
111 I $D(X) S IBLABEL=$P(NODE,"^"),IBID=+X,X=IBLABEL
112 Q
113 ;
114SLCTYN(X) ;for selecting YES or NO
115 ;
116 I "Yy"[$E(X) S X="YES",IBID=1 Q
117 I "Nn"[$E(X) S X="NO",IBID=0 Q
118 W "Enter YES or NO."
119 K X
120 Q
121 ;
122SLCTCLS(PI,X) ;for visit classification
123 ;pass X by reference
124 ;*NOTE: if interactive sets IBQUAL to the qualifier, IBLABEL to the recommended label, for use in the input template
125 ;example of use: D INPUTCLS^IBDFN12(PI,.X)
126 ;
127 N NODE
128 D LOOKUP(357.98,"I $$DQGOOD^IBDFU9(PI,Y)",.X,.NODE)
129 I $D(X) S IBID="",IBLABEL=$P(NODE,"^",3),IBQUAL=+X,X=$P(NODE,"^")
130 Q
Note: See TracBrowser for help on using the repository browser.