source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRM7XT.m@ 794

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

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