source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRM7XT.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 9.1 KB
Line 
1PXRM7XT ;SLC/JVS HL7 EXTRACT FROM FILE; 03/21/2002 ;4/11/02 15:26
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;This is the beginning of the extraction from the extract file
4 ;
5 ;VARIABLE LIST
6 ;IEN = IEN OF ENTRY IN EXTRACT FILE 810.3
7 Q
8SPLIT ;SPLIT MESSAGES
9 N ORC2
10 I LINE>100 D
11 .S ORCCNT=ORCCNT+1
12 .D EN^PXRM7M1(.ID)
13 .K ^TMP("HLS",$J)
14 .S ORC2=$G(^TMP("PXRM7HLORC",$J))
15 .S $P(ORC2,"|",3)="P"_ORCCNT,ORC=ORC2
16 .S LINE=2
17 .I $D(SEE) W !,ORC
18 .S ^TMP("HLS",$J,1)=ORC
19 Q
20 ;
21EXTRACT(IEN,SEE,ID,MODE) ;
22 N ORCCNT
23 K ERROR,LINE
24 S ORCCNT=1 ;Count of ORC segments or number of messages created
25 S LINE=1 ;Line count for the ^TMP("HL7",$J,LINE) global variable
26 ;-Verify Values
27 I '$D(^PXRMXT(810.3,IEN)) S ERROR(1)="No Such IEN in file 810.3 "_IEN
28 I $D(ERROR) D Q
29 .I $D(SEE)=1
30 ;-Extracting Value of Nodes in file
31 I $D(ERROR) Q
32 D GETS^DIQ(810.3,IEN,"**","EI","^TMP(""PXRM7"",$J)")
33 D ORCSEG
34 ;******Add NTE segment to end of message *******
35 ;******change 3rd piece of ORC segement to L (last)****
36 S NTE="NTE||"_LAST_"||"
37 S ^TMP("HLS",$J,LINE)=NTE,LINE=LINE+1
38 I SEE=1 W !,NTE
39 K NTE,LAST
40 S ORC=$G(^TMP("HLS",$J,1)),$P(ORC,"|",3)="F"_ORCCNT,^TMP("HLS",$J,1)=ORC
41 ;***********************************************
42 ;*******TURN ON BELOW TO TRANSMIT TO AUSTIN *****
43 D EN^PXRM7M1(.ID)
44 ;***********************************************
45 K ^TMP("PXRM7",$J)
46 K ^TMP("HLS",$J)
47 K ^TMP("PXRM7HLORC",$J)
48 ;********KILL LEFT OVER ARRAYS AND VARIABLES*****
49 K HL("EID"),HLA("HLS"),PROTIEN,PXRM7,PXRM77,PXRM7ID,PXRM7R,ZMID
50 K DA,DISYS,DISYS,EO,HL("EIDS"),HLECH,HLFS,HLN,HLQ,HLSAN,HLX
51 K IENIEN,IENOBR,IENX,IENY,IENZ,L,LINE,NEXT,QTI,RFS,SEQ
52 K STATION,USI
53 ;**************************************************
54 Q
55ORCSEG ;CREATE ORC SEGMENTS
56 ;ORDERED IN ORDER OF APPEARANCE IN SEGMENT
57 ;QTI=QUANTITY AND TIMING
58 ;EO=ENTERING ORGANIZATION
59 ;--Below adds extra line feed in front of the message. --
60 ;---------------------------------------------------
61 S IENY=IEN_","
62 ;---------------------------------------------
63 ;0 PLACER ORDER NUMBER ORC.2.1
64 S $P(ORC,"|",3)="P1"
65 ;---------------------------------------------
66 ;1 REPORTING PERIOD ORC.7.1.1
67 S QTI(1)=$G(^TMP("PXRM7",$J,810.3,IENY,3,"E"))
68 S $P(QTI,"~",1)=QTI(1)
69 ;---------------------------------------------
70 ;2 QUARTER ORC.7.3
71 S QTI(3)=$G(^TMP("PXRM7",$J,810.3,IENY,7,"E"))
72 S $P(QTI,"~",3)=QTI(3)
73 ;---------------------------------------------
74 ;3 BEGINNING DATE ORC.7.4.1
75 S QTI(4)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.02,"I")),"DT")
76 S $P(QTI,"~",4)=QTI(4)
77 ;---------------------------------------------
78 ;4 ENDING DATE ORC.7.5.1
79 S QTI(5)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.03,"I")),"DT")
80 S $P(QTI,"~",5)=QTI(5)
81 ;---------------------------------------------
82 ;5 REPORTING YEAR ORC.7.11.2
83 S QTI(11)="&"_$G(^TMP("PXRM7",$J,810.3,IENY,4,"E"))
84 S $P(QTI,"~",11)=QTI(11)
85 ;---------------------------------------------
86 ;6 EXTRACT DATE ORC.9.1
87 S $P(ORC,"|",10)=$$HLDATE^HLFNC($G(^TMP("PXRM7",$J,810.3,IENY,.06,"I")),"DT")
88 ;---------------------------------------------
89 ;7 NAME ORC.17.2
90 S EO(2)=$G(^TMP("PXRM7",$J,810.3,IENY,.01,"E"))
91 S $P(EO,"~",2)=EO(2)
92 ;---------------------------------------------
93 ;8 REPORT EXTRACT PARAMETER ORC.17.5
94 S EO(5)=$G(^TMP("PXRM7",$J,810.3,IENY,1,"E"))
95 S $P(EO,"~",5)=EO(5)
96 ;---------------------------------------------
97 ;9 REPORT EXTRACT TYPE ORC.18.2
98 S $P(ORC,"|",19)="~"_$G(^TMP("PXRM7",$J,810.3,IENY,2,"E"))
99 ;---------------------------------------------
100 ;FINISH POPULATING ORC SEGMENT
101 S $P(ORC,"|",8)=QTI
102 S $P(ORC,"|",18)=EO
103 S $P(ORC,"|",1)="ORC"
104 ;---------------------------------------------
105 ;SET HL7 TMP ARRAY AND SHOW SEGMENT
106 S ^TMP("HLS",$J,LINE)=ORC,LINE=LINE+1
107 I SEE=1 W !,ORC
108 S ^TMP("PXRM7HLORC",$J)=ORC
109 K ORC
110OBRSEG ;CREATE OBR SEGMENTS
111 ;N IENOBR,SEQ,USI,QTI,NEXT,STATION
112 ;USI=UNIVERSAL SERVICE ID
113 ;RFS=REASON FOR STUDY
114 ;
115 S NEXT=1,LAST=0
116 S IENOBR=0 F S IENOBR=$O(^PXRMXT(810.3,IEN,3,IENOBR)) Q:IENOBR<1 D
117 .S IENIEN=-1 F S IENIEN=$O(^PXRMXT(810.3,IEN,3,IENOBR,1,IENIEN)) Q:IENIEN="B" D Q:IENIEN=""
118 ..S L=$S(IENIEN=0:1,IENIEN>0:2,IENIEN="":1,1:"")
119 ..;###---Set Sequence Number
120 ..S IENX=IENOBR_","_IEN_","
121 ..S IENZ=IENIEN_","_IENOBR_","_IEN_","
122 ..S SEQ=$G(^TMP("PXRM7",$J,810.33,IENX,.01,"E"))
123 ..S OBR(+SEQ_L)="OBR|1|||||||||||||||||||||||||||||||"
124 ..S $P(OBR(+SEQ_L),"|",2)=NEXT,LAST=NEXT,NEXT=NEXT+1
125 ..;--------------------------------------------------
126 ..;10 COUNT TYPE OBR.4.2
127 ..;R=REMINDER COUNTS F=FINDING COUNTS
128 ..S USI(2)=$S(L=1:"R",L=2:"F",1:"")
129 ..S $P(USI,"~",2)=USI(2)
130 ..;--------------------------------------------------
131 ..;11 REMINDER OBR.4.5
132 ..S USI(5)=$G(^TMP("PXRM7",$J,810.33,IENX,.02,"E"))
133 ..S $P(USI,"~",5)=USI(5)
134 ..;--------------------------------------------------
135 ..;12 STATION OBR.3.1
136 ..S STATION=$G(^TMP("PXRM7",$J,810.33,IENX,.03,"I"))_","
137 ..D GETS^DIQ(4,STATION,"**","E","^TMP(""PXRM7"",$J)")
138 ..S $P(OBR(+SEQ_L),"|",4)=$G(^TMP("PXRM7",$J,4,STATION,99,"E"))
139 ..;--------------------------------------------------
140 ..;13 PATIENT LIST OBR.31.2
141 ..S RFS(2)=$G(^TMP("PXRM7",$J,810.33,IENX,.04,"E"))
142 ..S $P(RFS,"~",2)=RFS(2)
143 ..;--------------------------------------------------
144 ..;19 REMINDER TERM OBR.31.1
145 ..S RFS(1)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.02,"E")),1:"")
146 ..S $P(RFS,"~",1)=RFS(1)
147 ..;--------------------------------------------------
148 ..;20 FINDING TOTAL TYPE OBR.31.4
149 ..S RFS(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.03,"E")),1:"")
150 ..S $P(RFS,"~",4)=RFS(4)
151 ..;--------------------------------------------------
152 ..;21 GROUP NAME OBR.31.5
153 ..S RFS(5)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.04,"E")),1:"")
154 ..S $P(RFS,"~",5)=RFS(5)
155 ..;--------------------------------------------------
156 ..;22 REMINDER STATUS OBR.4.4
157 ..S USI(4)=$S(L=2:$G(^TMP("PXRM7",$J,810.331,IENZ,.05,"I")),1:"")
158 ..S $P(USI,"~",4)=USI(4)
159 ..;-------------------------------------------------
160 ..;FINISH POPULATING OBR SEGMENT
161 ..S $P(OBR(+SEQ_L),"|",5)=USI
162 ..S $P(OBR(+SEQ_L),"|",32)=RFS
163 ..;-------------------------------------------------
164 ..;---Set message in HL7 array
165 ..;I $L($G(OBR(+SEQ_L)))=255 S OBR(+SEQ_L)=OBR(+SEQ_L)_"|||"
166 ..S ^TMP("HLS",$J,LINE)=$G(OBR(+SEQ_L)),LINE=LINE+1
167 ..;
168 ..I SEE=1 W !," ",OBR(+SEQ_L)
169 ..K OBR
170 ..D OBXSEG
171 ..D SPLIT
172 ..I (L=1)&(IENIEN="") Q
173 Q
174OBXSEG ;CREATE THE OBX SEGMENTS
175 N TERM
176 ;OV=OBSERVATION VALUE
177 S $P(OBX(+SEQ_L),"|",3)="MO"
178 S $P(OBX(+SEQ_L),"|",1)="OBX"
179 ;---------------------------------------------------
180 ;###---SET SEQUENCE NUMBER
181 S $P(OBX(+SEQ_L),"|",2)=1
182 ;---------------------------------------------------
183 ;14 TOTAL PATIENTS EVALUATED - REMINDER OBX.5.1
184 I L=1 D
185 .S TERM="TOTAL PATIENTS EVALUATED"
186 .S OV(1)=$G(^TMP("PXRM7",$J,810.33,IENX,2,"E"))_"~"_TERM
187 .S $P(OV,"^",1)=OV(1)
188 ;---------------------------------------------------
189 ;15 TOTAL PATIENTS APPLICABLE - REMINDER OBX.5.2
190 I L=1 D
191 .S TERM="TOTAL PATIENTS APPLICABLE"
192 .S OV(2)=$G(^TMP("PXRM7",$J,810.33,IENX,3,"E"))_"~"_TERM
193 .S $P(OV,"^",2)=OV(2)
194 ;---------------------------------------------------
195 ;16 TOTAL PATIENTS NOT APPLICABLE - REMINDER OBX.5.3
196 I L=1 D
197 .S TERM="TOTAL PATIENTS NOT APPLICABLE"
198 .S OV(3)=$G(^TMP("PXRM7",$J,810.33,IENX,4,"E"))_"~"_TERM
199 .S $P(OV,"^",3)=OV(3)
200 ;---------------------------------------------------
201 ;17 TOTAL PATIENTS DUE - REMINDER OBX.5.4
202 I L=1 D
203 .S TERM="TOTAL PATIENTS DUE"
204 .S OV(4)=$G(^TMP("PXRM7",$J,810.33,IENX,5,"E"))_"~"_TERM
205 .S $P(OV,"^",4)=OV(4)
206 ;---------------------------------------------------
207 ;18 TOTAL PATIENTS NOT DUE - REMINDER OBX.5.5
208 I L=1 D
209 .S TERM="TOTAL PATIENTS NOT DUE"
210 .S OV(5)=$G(^TMP("PXRM7",$J,810.33,IENX,6,"E"))_"~"_TERM
211 .S $P(OV,"^",5)=OV(5)
212 ;---------------------------------------------------
213 ;23 TOTAL COUNT - FINDING OBX.5.1
214 I L=2 D
215 .S TERM="TOTAL COUNT"
216 .S OV(1)=$G(^TMP("PXRM7",$J,810.331,IENZ,1,"E"))_"~"_TERM
217 .S $P(OV,"^",1)=OV(1)
218 ;---------------------------------------------------
219 ;24 APPLICABLE COUNT - FINDING OBX.5.2
220 I L=2 D
221 .S TERM="APPLICABLE COUNT"
222 .S OV(2)=$G(^TMP("PXRM7",$J,810.331,IENZ,2,"E"))_"~"_TERM
223 .S $P(OV,"^",2)=OV(2)
224 ;---------------------------------------------------
225 ;25 NOT APPLICABLE COUNT- FINDING OBX.5.3
226 I L=2 D
227 .S TERM="NOT APPLICABLE COUNT"
228 .S OV(3)=$G(^TMP("PXRM7",$J,810.331,IENZ,3,"E"))_"~"_TERM
229 .S $P(OV,"^",3)=OV(3)
230 ;---------------------------------------------------
231 ;26 DUE COUNT - FINDING OBX.5.4
232 I L=2 D
233 .S TERM="DUE COUNT"
234 .S OV(4)=$G(^TMP("PXRM7",$J,810.331,IENZ,4,"E"))_"~"_TERM
235 .S $P(OV,"^",4)=OV(4)
236 ;---------------------------------------------------
237 ;27 NOT DUE COUNT - FINDING OBX.5.5
238 I L=2 D
239 .S TERM="NOT DUE COUNT"
240 .S OV(5)=$G(^TMP("PXRM7",$J,810.331,IENZ,5,"E"))_"~"_TERM
241 .S $P(OV,"^",5)=OV(5)
242 ;---------------------------------------------------
243 ;FINISH POPULATING OBX SEGMENT
244 S $P(OBX(+SEQ_L),"|",6)=OV
245 K OV
246 ;---------------------------------------------------
247 ;###---Set message in HL7 array
248 S ^TMP("HLS",$J,LINE)=$G(OBX(+SEQ_L)),LINE=LINE+1
249 ;
250 I SEE=1 W !," ",OBX(+SEQ_L)
251 K OBX
252 ;---------------------------------------------------
253 Q
Note: See TracBrowser for help on using the repository browser.