source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUTL1.m@ 1764

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1ECUTL1 ;ALB/ESD - Event Capture Classification Utilities ;19 May 98
2 ;;2.0; EVENT CAPTURE ;**10,13,17,42,54**;8 May 96
3 ;
4ASKCLASS(DFN,ECANS,ERR,ECTOPCE,ECPATST,ECHDA) ; Ask classification questions (Agent Orange, Ionizing Radiation, Environmental Contaminants, Service Conn)
5 ;
6 ; Input:
7 ; DFN - IEN of Patient file (#2)
8 ; ECTOPCE - Variable which indicates if DSS Unit is sending to PCE
9 ; ECPATST - Inpatient/outpatient status
10 ; ECHDA - IEN in file #721 if editing existing record [optional]
11 ;
12 ; Output:
13 ; ECANS - array subscripted by classification abbreviation
14 ; (i.e. ECANS("AO")) and passed by reference containing:
15 ; field # of class from EC Patient file (#721)^answer
16 ; ERR - Error indicator if user uparrows or times out (set to 1)
17 ;
18 ; Function value - 1 if successful, 0 otherwise
19 ;
20 N ANS,DIR,ECCL,ECCLFLD,SUCCESS,ECVST,ECVSTDT,ECPXB,PXBDATA,ECNT,ECOLD,ECPIECE,ECXX
21 S (ECANS,ECCL)=""
22 S ERR=0
23 S SUCCESS=1
24 S DFN=+$G(DFN)
25 S ECTOPCE=$G(ECTOPCE)
26 I ECTOPCE["~" S ECTOPCE=$P(ECTOPCE,"~",2)
27 S ECPATST=$G(ECPATST)
28 ;- Drop out if invalid condition found OR if DSS Unit not sending to
29 ; PCE or patient is an inpatient
30 I ('DFN)!(ECTOPCE="")!(ECPATST="")!(ECTOPCE="N")!(ECPATST="I") S SUCCESS=0 Q SUCCESS
31 D NOW^%DTC S ECVSTDT=$S(+$G(ECDT):ECDT,1:%),ECVST="" ;modified to use event date;JAM/11/24/03
32 ;- If editing an existing record, get visit data & display classification
33 I $G(ECHDA) D
34 .S ECVSTDT=$P($G(^ECH(ECHDA,0)),U,3)
35 .S ECVST=$P($G(^ECH(ECHDA,0)),U,21)
36 .F ECCL="AO","IR","EC","SC","MST","HNC","CV" D
37 ..S ECCLFLD=$S(ECCL="AO":"Agent Orange",ECCL="IR":"Ionizing Radiation",ECCL="EC":"Environmental Contaminants",ECCL="SC":"Service Connected",ECCL="HNC":"Head/Neck Cancer",ECCL="CV":"Combat Veteran",1:"Military Sexual Trauma")
38 ..S ECPIECE=$S(ECCL="AO":3,ECCL="IR":4,ECCL="EC":5,ECCL="SC":6,ECCL="MST":9,ECCL="HNC":10,1:11)
39 ..S ECXX=$P($G(^ECH(ECHDA,"P")),U,ECPIECE),ECXX=$S(ECXX="Y":"YES",ECXX="N":"NO",1:"")
40 ..I ECXX]"" S ECOLD(ECCL)=ECCLFLD_": "_ECXX
41 .I $D(ECOLD) D
42 ..W !,"*** Current encounter classification ***",!
43 ..F ECCL="SC","CV","AO","IR","EC","MST","HNC" D
44 ...I $D(ECOLD(ECCL)) W !?4,ECOLD(ECCL)
45 ;- Ask user classification question
46 D CLASS^PXBAPI21("",DFN,ECVSTDT,1,ECVST) W !
47 ;- Check error; exit if error condition
48 I $D(PXBDATA("ERR")) D I ERR S SUCCESS=0 Q SUCCESS
49 .F ECPXB=1:1:4 I $D(PXBDATA("ERR",ECPXB)) D
50 ..I (PXBDATA("ERR",ECPXB)=1)!(PXBDATA("ERR",ECPXB)=4) S ERR=1
51 ;- Otherwise, continue to setup ecans array, i.e., new classification data
52 F ECCL="AO","IR","SC","EC","MST","HNC","CV" D
53 .S ECCLFLD=$S(ECCL="AO":21,ECCL="IR":22,ECCL="EC":23,ECCL="SC":24,ECCL="MST":35,ECCL="HNC":39,1:40)
54 .S ECPXB=$S(ECCL="AO":1,ECCL="IR":2,ECCL="EC":4,ECCL="SC":3,ECCL="MST":5,ECCL="CV":7,1:6)
55 .S ANS=$P($G(PXBDATA(ECPXB)),U,2),ANS=$S(ANS=1:"Y",ANS=0:"N",1:"")
56 .S ECANS(ECCL)=ECCLFLD_"^"_ANS
57 ;- Delete old data if it exists
58 I $G(ECHDA) D DELCLASS(ECHDA)
59 Q SUCCESS
60 ;
61 ;
62EDCLASS(ECIEN,ECANS) ; Edit classifications fields in EC Patient
63 ; file (#721)
64 ;
65 ; Input:
66 ; ECIEN - EC Patient record (#721) IEN
67 ; ECANS - Array of answers to classification questions asked
68 ;
69 ; Output:
70 ; Classification fields 21,22,23,24,35,39,40 edited in file #721
71 ;
72 N DA,DIE,DR,ECCL
73 S (DR,ECCL)=""
74 ;
75 ;- Drops out if invalid condition found
76 D
77 . I '$G(ECIEN)!('$D(ECANS)) Q
78 . ;
79 . ;- Lock main node
80 . I '$$LOCK(ECIEN) Q
81 . S DA=ECIEN
82 . S DIE="^ECH("
83 . ;
84 . ;- Edit classification fields (AO, IR, EC, SC, MST, HNC, CV)
85 . F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" S DR=DR_+$P($G(ECANS(ECCL)),"^")_"////"_$P($G(ECANS(ECCL)),"^",2)_";"
86 . ;
87 . ;- Remove last ";" from DR string before editing
88 . S DR=$E(DR,1,($L(DR)-1))
89 . D ^DIE
90 ;
91 ;- Unlock main node
92 D UNLOCK(ECIEN)
93 ;
94 Q
95 ;
96 ;
97SETCLASS(ECANS) ; Set answers to classification questions in EC variables
98 ; (used in EC data entry options when filing EC Patient record)
99 ;
100 ; Input:
101 ; ECANS - array of answers to class questions asked containing:
102 ; field number of class ques from file #721^answer
103 ;
104 ; Output:
105 ; EC classification var - ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV
106 ;
107 N ECCL,ECCLFLD
108 S (ECCL,ECAO,ECIR,ECZEC,ECSC,ECMST,ECHNC,ECCV)=""
109 ;
110 ;- Drops out if invalid condition found
111 D
112 . ;
113 . ;- If array containing class flds^answers is not created, exit
114 . I '$D(ECANS) Q
115 . F S ECCL=$O(ECANS(ECCL)) Q:ECCL="" D
116 .. ;
117 .. ;- Get field number of classification
118 .. S ECCLFLD=+$P($G(ECANS(ECCL)),"^")
119 .. ;
120 .. ;- Agent Orange variable
121 .. S:ECCLFLD=21 ECAO=$P(ECANS(ECCL),"^",2)
122 .. ;
123 .. ;- Ionizing Radiation variable
124 .. S:ECCLFLD=22 ECIR=$P(ECANS(ECCL),"^",2)
125 .. ;
126 .. ;- Environmental Contaminants variable
127 .. S:ECCLFLD=23 ECZEC=$P(ECANS(ECCL),"^",2)
128 .. ;
129 .. ;- Service Connected variable
130 .. S:ECCLFLD=24 ECSC=$P(ECANS(ECCL),"^",2)
131 .. ;
132 .. ;- Military Sexual Trauma variable
133 .. S:ECCLFLD=35 ECMST=$P(ECANS(ECCL),"^",2)
134 .. ;
135 .. ;- Head/Neck Cancer
136 .. S:ECCLFLD=39 ECHNC=$P(ECANS(ECCL),"^",2)
137 .. ;
138 .. ;- Combat Veteran
139 .. S:ECCLFLD=40 ECCV=$P(ECANS(ECCL),"^",2)
140 Q
141 ;
142 ;
143DELCLASS(ECIEN) ; Delete classification fields in EC Patient file (#721)
144 ;
145 ; Input:
146 ; ECIEN - EC Patient record (#721) IEN
147 ;
148 ; Output:
149 ; Classification fields 21,22,23,24,35,39,40 deleted in file #721
150 ;
151 N DA,DIE,DR,ECCL
152 S DR=""
153 ;
154 ;- Drops out if invalid condition found
155 D
156 . I '$G(ECIEN) Q
157 . ;
158 . ;- Lock main node
159 . I '$$LOCK(ECIEN) Q
160 . S DA=ECIEN
161 . S DIE="^ECH("
162 . ;
163 . ;- Delete classification fields (AO, IR, EC, SC, MST, HNC, CV)
164 . F ECCL=21:1:24,35,39,40 S DR=DR_ECCL_"////@;"
165 . ;
166 . ;- Remove last ";" from DR string before editing
167 . S DR=$E(DR,1,($L(DR)-1))
168 . D ^DIE
169 ;
170 ;- Unlock main node
171 D UNLOCK(ECIEN)
172 ;
173 Q
174 ;
175 ;
176LOCK(ECIEN) ; Lock EC Patient record
177 ;
178 ; Input:
179 ; ECIEN - EC Patient record IEN
180 ;
181 ; Output:
182 ; Function Value - 1 if record can be locked, 0 otherwise
183 ;
184 I $G(ECIEN) L +^ECH(ECIEN):5
185 Q $T
186 ;
187 ;
188UNLOCK(ECIEN) ; Unlock EC Patient record
189 ;
190 ; Input:
191 ; ECIEN - EC Patient record IEN
192 ;
193 ; Output:
194 ; EC Patient record unlocked
195 ;
196 I $G(ECIEN) L -^ECH(ECIEN)
197 Q
Note: See TracBrowser for help on using the repository browser.