source: WorldVistAEHR/trunk/r/VISTA_OFFICE_EHR-VEPE/VEPER7SG.m@ 701

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

initial load of WorldVistAEHR
File size: 9.5 KB
RevLine 
[613]1VEPER7SG ;DOQ-IT HL7 Segment generation routine ; 10/11/05 10:22am
2 ;;1.0;VOE;;Nov 16, 2005
3FHS(SF,FHSC,BHSC,PROD,FNM,FNMID) ;File Header Segment
4 ;
5 ; SF - Sending Facility
6 ; FHSC - File Header Segment id & count *** PASS BY REFERENCE ***
7 ; BHSC - Batch Header Segment Count ***
8 ; PROD - Production indicator
9 ; FNM - File name
10 ; FNMID - Facility UPIN #
11 ;
12 S FNM=$P(FNM,"\",3) ;***CBF*** RESET FNM
13 S TP=$S(PROD:"PROD",1:"TEST")
14 S FHSC=FHSC+1,BHSC=0
15 W "FHS|^~\&|VISTAEHR|"_SF_"|||||"_FNMID_"|"_TP_"|"_FNM_"||||||||||"
16 W ! Q
17 ;
18 ;
19BHS(SF,BHSC,MSHC) ;Batch Header Segment
20 ;
21 S BHSC=BHSC+1,MSHC=0
22 W "BHS|^~\&|VISTAEHR|"_SF_"|||||||BHS"_$E(1000+BHSC,2,4)_"|||||"
23 W ! Q
24 ;
25MSH(MC,TE,SF,MSHC) ;Message Header Segment
26 ;
27 ; MC - Message code first piece of MSH-9
28 ; TE - Trigger Event second piece of MSH-9
29 ; MSHC - Message Control ID Counter
30 ;
31 N X,C1,CC,DTTM
32 S DTTM=$$DTCALC("T","N")_"00"
33 S MSHC=MSHC+1
34 W "MSH|^~\&|VISTAEHR|"_SF_"|DOQ-IT||"_DTTM_"||"_MC_"^"_TE_"|MSG"_$E(100000+MSHC,2,99)_"|P|2.5||||"
35 W ! Q
36 ;
37EVN(EVNTYPE) ;EVENT TYPE SEGMENT
38 ;
39 N REC
40 S REC=""
41 S $P(REC,"|")=EVNTYPE
42 S $P(REC,"|",2)=DTZ
43 W "EVN|"_REC
44 W ! Q
45 ;
46ZCR ;Primary Practice segment data
47 ;
48 N REC
49 S REC=""
50 ; Pieces 1-11 Are Primary Clinic Information
51 S $P(REC,"|",1)=CONFIG(19904.5,CFGIEN,.02) ; Group Upin
52 S $P(REC,"|",2)=CONFIG(19904.5,CFGIEN,.03) ; Name
53 S PCADD=CONFIG(19904.5,CFGIEN,.04)_"^"_CONFIG(19904.5,CFGIEN,.05)_"^"_CONFIG(19904.5,CFGIEN,.06) ; Primary Clinic Address 1~2
54 S $P(REC,"|",3)=PCADD ;Primary Clinic Address
55 S $P(REC,"|",4)=CONFIG(19904.5,CFGIEN,.07) ; City
56 S $P(REC,"|",5)=CONFIG(19904.5,CFGIEN,.071) ; State
57 S $P(REC,"|",6)=CONFIG(19904.5,CFGIEN,.072) ; Zip
58 S $P(REC,"|",7)=CONFIG(19904.5,CFGIEN,.081) ; Phone
59 S $P(REC,"|",8)=CONFIG(19904.5,CFGIEN,.083) ; Email
60 S $P(REC,"|",9)=CLSTDT ; Start Date
61 S $P(REC,"|",10)=CLENDT ; End Date
62 S $P(REC,"|",11)=CONFIG(19904.5,CFGIEN,.08) ; Contact Name
63 W "ZCR|"_REC
64 W ! Q
65 ;
66ZPP ;Practice Patients segment data
67 ;
68 N REC,PTFNM,PTLNM,PTMI,EG,PS,X,RACE,SEX
69 S REC=""
70 S $P(REC,"|",1)=CONFIG(19904.5,CFGIEN,.02) ;Primary Clinic Group Upin
71 S $P(REC,"|",2)="MR" ;Patient ID List Code Sys
72 ;
73 ;***CBF*** Patient ID - need to find in IHS patient file
74 ;
75 N PATDFN,DOQPATID
76 S PATDFN=$P($O(DOQREG("19904.4","")),",")
77 S DOQPATID=$P(^AUPNPAT(PATDFN,41,DUZ(2),0),"^",2)
78 S $P(REC,"|",3)=DOQPATID
79 S PTLNM=$P(VEPER7PT(2,DFN,.01),","),PTFNM=$P(VEPER7PT(2,DFN,.01),",",2)
80 S PTMI=$E($P(PTFNM," ",2))
81 S $P(REC,"|",4)=$P(PTFNM," ") ;Patient First Name
82 S $P(REC,"|",5)=PTMI ; Middle Initial
83 S $P(REC,"|",6)=PTLNM ; Last Name
84 S $P(REC,"|",7)=PRIPHN ;PRIMARY PHYSICIAN UPIN
85 S $P(REC,"|",8)=$P($$FMTHL7^XLFDT(VEPER7PT(2,DFN,.03,"I")),"-") ; DOB
86 ;
87 ; ***CBF*** ETHNIC GROUP, SEX, RACE AND PAYSOURCE ARE REQUIRED AND NEED TO BE HL7 ENCODED
88 ;
89 S EG=$O(VEPER7PT(2.06,""))
90 I EG'="" S EG=$G(VEPER7PT(2.06,EG,.01))
91 S EG=$S(EG="HISPANIC OR LATINO":"H",EG="NOT HISPANIC OR LATINO":"N",1:"U")
92 S $P(REC,"|",9)=EG
93 ;
94 S SEX=VEPER7PT(2,DFN,.02)
95 S $P(REC,"|",10)=$S(SEX="MALE":"M",SEX="FEMALE":"F",1:"U")
96 ;
97 S RACE=VEPER7PT(2,DFN,.06)
98 S RACE=$S(RACE="AMERICAN INDIAN OR ALASKA NATIVE":"1002-5",RACE="ASIAN":"2028-9",RACE="BLACK OR AFRICAN AMERICAN":"2054-5",RACE="NATIVE HAWAIIAN OR OTHER PACIFIC ISLANDER":"2076-8",RACE="WHITE":"2106-3",1:"2131-1")
99 S $P(REC,"|",11)=RACE
100 S $P(REC,"|",12)=DOQREG(19904.4,PATDFN_",",".014") ;Paysource
101 S $P(REC,"|",13)=DOQREG(19904.4,PATDFN_",",".015") ;HIC #
102 S $P(REC,"|",14)=$S(VEPER7PT(2,DFN,.09)?9N:VEPER7PT(2,DFN,.09),1:"") ;SSN
103 S BENEADD=VEPER7PT(2,DFN,.2914)_"~"_VEPER7PT(2,DFN,.2915)
104 S $P(REC,"|",15)=BENEADD ;BENEFACTOR ADDRESS
105 S $P(REC,"|",16)=VEPER7PT(2,DFN,.2916) ; " CITY
106 S $P(REC,"|",17)=VEPER7PT(2,DFN,.2917) ; " STATE
107 S $P(REC,"|",18)=VEPER7PT(2,DFN,.2918) ; " ZIP
108 W "ZPP|"_REC
109 W ! Q
110 ;
111 ;
112DG1 ;Diagnosis segment
113 ;
114 ;***CBF*** THERE COULD BE MORE THAN ONE DIAGNOSIS, NEED TO LOOP AND FIND THEM ALL
115 ;
116 N PATDFN2,TRACE
117 S TRACE="",PATDFN2=$P(DFN,","),SETID=0
118 F S TRACE=$O(^AUPNPROB("AC",PATDFN2,TRACE)) Q:'TRACE D
119 .I $P($G(^AUPNPROB(TRACE,0)),"^",12)'="A" Q
120 .D GETS^DIQ(9000011,TRACE_",","**","","VEPER7PT")
121 .S X=$G(VEPER7PT(9000011,TRACE_",",.03)),X=$P(X,"@"),%DT="T" D ^%DT
122 .I Y'=VISITDT&DGREG'=1 Q ; FOR PATIENT REGISTRATION, PASS ALL PROBLEMS, FOR VISIT, PASS ONLY VISIT RELATED PROBLEMS
123 .S SETID=SETID+1,DATE=Y D
124 ..N REC
125 ..S REC=""
126 ..S $P(REC,"|")=SETID
127 ..S $P(REC,"|",3)=$G(VEPER7PT("9000011",TRACE_",",.01))_"^"_$G(VEPER7PT("9000011",TRACE_",",.05))_"^I9" ; CODE^TEXT^SYSTEM
128 ..S DATE=$P($$FMTHL7^XLFDT(DATE),"-")
129 ..S $P(REC,"|",5)=DATE ; DIAGNOSIS DATE
130 ..S $P(REC,"|",6)="F" ;Diagnosis Type - Final
131 ..S $P(REC,"|",16)=PRIPHN ;Diagnosis Clinician
132 ..W "DG1|"_REC
133 ..W !
134 Q
135 ;
136 ;
137ZPT ;Practice Patients Topics segment data
138 ;
139 N REC
140 S REC=""
141 S $P(REC,"|",1)=CONFIG(19904.5,CFGIEN,.02) ;Primary Clinic Group Upin
142 S $P(REC,"|",2)="MR" ;Patient ID List Code Sys
143 ;
144 ;***CBF*** Patient ID - need to find in IHS patient file
145 ;
146 S DOQPATID=$P(^AUPNPAT(PATDFN,41,DUZ(2),0),"^",2)
147 S $P(REC,"|",3)=DOQPATID
148 S $P(REC,"|",4)=TOPTYP ;Topic Type
149 S $P(REC,"|",5)=TOPIND ;Topic Indicator
150 S $P(REC,"|",6)=$E(ENEFFDT,1,8) ;Enrollment Effective Date
151 S $P(REC,"|",7)=$E(ENCLSDT,1,8) ;Enrollment Close Date
152 W "ZPT|"_REC
153 W ! Q
154 ;
155 ;
156PID ;
157 ;
158 N REC
159 S REC=""
160 S $P(REC,"|",1)="1" ;Set ID
161 ;
162 ;***CBF*** Patient ID - need to find in IHS patient file
163 ;
164 S DOQPATID=$P(^AUPNPAT(PATDFN,41,DUZ(2),0),"^",2)
165 S $P(REC,"|",3)=DOQPATID_"^^^^MR"
166 W "PID|"_REC
167 W ! Q
168 ;
169 ;
170PV1 ;
171 ;
172 N REC
173 S REC=""
174 S $P(REC,"|",2)="R"
175 S $P(REC,"|",19)=VSTNO ;Visit Number
176 S DTTM=$G(VISIT(9000010,VSTIEN,.01,"I")),DTTM=$P(DTTM,".")
177 S $P(REC,"|",44)=$P($$FMTHL7^XLFDT(DTTM),"-") ;Admit Date/Time
178 W "PV1|"_REC
179 W ! Q
180 ;
181 ;
182ZL1 ;
183 ;
184 ;***CBF*** MODIFIED TO PASS ALLERGEN TYPE CODE AS AN ACTUAL CODE, RATHER THAN TEXT
185 ; ALSO CHANGED ALLERGEN TO A CODE^TEXT^CODE SYSTEM (WHICH MUST BE SNOMED-2)
186 ; BASED ON LEXICON SEARCH. THERE COULD ALSO BE MORE THAN ONE ALLERY, NEED
187 ; TO FIND THEM ALL
188 ;
189 N PATDFN2,TRACE,DATE
190 S TRACE="",PATDFN2=$P(DFN,","),SETID=0
191 F S TRACE=$O(^GMR(120.8,"B",PATDFN2,TRACE)) Q:'TRACE D
192 . D GETS^DIQ(120.8,TRACE_",","**","","VEPER7PT")
193 . S X=$G(VEPER7PT(120.8,TRACE_",",4)),X=$P(X,"@"),%DT="T" D ^%DT
194 . I Y'=VISITDT&ALLREG'=1 Q ; FOR PATIENT REGISTRATION, PASS ALL ALLERGIES, FOR VISIT, PASS ONLY VISIT RELATED ALLERGIES
195 . S SETID=SETID+1 D
196 ..N REC,SEARCH,ALLIEN,LEX
197 ..S REC=""
198 ..S $P(REC,"|",1)=SETID ;Set ID ZL1
199 ..S TYPE=$G(VEPER7PT(120.8,TRACE_",",3.1))
200 ..S TYPE=$S(TYPE["FOOD":"FA",TYPE["DRUG":"DA",TYPE["POLLEN":"PA",TYPE["PLANT":"PA",TYPE["ANIMAL":"AA",TYPE["ENVIRON":"EA",1:"MA")
201 ..S $P(REC,"|",2)=TYPE ;Allergen Type Code
202 ..S SEARCH=$G(VEPER7PT(120.8,TRACE_",",1))
203 ..I SEARCH'="" S ALLIEN=$O(^LEX(757.01,"B",SEARCH,"")) I ALLIEN'="" D INFO^LEXA(ALLIEN)
204 ..S $P(REC,"|",3)=$P($G(LEX("SEL","SRC","1")),"^",2)_"^"_SEARCH_"^SNM"
205 ..S DATE=$P($$FMTHL7^XLFDT(Y),"-")
206 ..S $P(REC,"|",6)=DATE ;Allergen Identification Date
207 ..W "ZL1|"_REC
208 ..W !
209 ..K LEX
210 Q
211 ;
212 ;
213ORC ;
214 ;
215 N REC
216 S REC=""
217 S $P(REC,"|",1)="OK"
218 S $P(REC,"|",2)=$S(ORCTYPE="PHARM":"P",1:"I")_TRACE ; PLACER ORDER NUMBER - UNIQUE ORDER NUMBER FOR ORDER
219 S $P(REC,"|",12)=PRIPHN
220 I ORCTYPE="IMMUNE" S X=$G(IMMUNE(9000010.11,TRACE_",",.03)),X=$P(X,"@"),%DT="T" D ^%DT
221 I ORCTYPE="PHARM" S RXIEN=TRACE2_"," D GETS^DIQ(52,RXIEN,1,"I","MEDDATA") S Y=$G(MEDDATA(52,RXIEN,1,"I"))
222 I Y="" S Y=VISITDT
223 S $P(REC,"|",15)=$P($$FMTHL7^XLFDT(Y),"-")
224 S $P(REC,"|",21)=FNMID
225 W "ORC|"_REC
226 W ! Q
227 ;
228 ;
229OBR ;
230 ;
231 ;***CBF*** FLESHED THIS OUT FOR FUTURE USE. VOE WON'T SEND OBR SEGMENTS,
232 ; BUT MIGHT IN THE FUTURE.
233 ;
234 ;N REC S REC=""
235 ;S $P(REC,"|",4)="" ; UNIVERSAL SERVICE IDENTIFIER - CODE^TEXT^CODE SYSTEM
236 ;S $P(REC,"|",7)=DTTM ; OBSERVATION DATE TIME
237 ;S $P(REC,"|",22)="" ; RESULTS REPORT
238 ;S $P(REC,"|",)=""
239 ;W "OBR|"_REC
240 ;W ! Q
241 Q
242 ;
243 ;
244RXO ;
245 ;
246 N RXIEN,REC,MEDDATA,DRUGIEN,DRUGAMT,DRUGDAY,DRUGREF,DRUGNDC,DRUGDATA,DRUGTEXT,DISPCODE
247 S RXIEN=TRACE2_",",REC=""
248 K MEDDATA D GETS^DIQ(52,RXIEN,"6;7;8;9;27;","I","MEDDATA")
249 S DRUGIEN=$G(MEDDATA(52,RXIEN,6,"I"))_","
250 S DRUGAMT=$G(MEDDATA(52,RXIEN,7,"I"))
251 S DRUGDAY=$G(MEDDATA(52,RXIEN,8,"I"))
252 S DRUGREF=$G(MEDDATA(52,RXIEN,9,"I"))
253 S DRUGNDC=$G(MEDDATA(52,RXIEN,27,"I"))
254 K DRUGDATA D GETS^DIQ(50,DRUGIEN,".01","","DRUGDATA")
255 S DRUGTEXT=$G(DRUGDATA(50,DRUGIEN,.01))
256 S DRUGNDC=$P(DRUGNDC,"-")_$P(DRUGNDC,"-",2)_$P(DRUGNDC,"-",3)
257 S $P(REC,"|")=DRUGNDC_"^"_DRUGTEXT_"^NDC" ;DRUG INFORMATION = CODE^TEXT^CODE SYSTEM (always NDC)
258 S $P(REC,"|",11)=DRUGAMT ;DISPENSE AMOUNT
259 S $P(REC,"|",13)=DRUGREF ;NUMBER OF REFILLS
260 S TOTQTY=DRUGAMT/DRUGDAY,TOTQTY=$E(TOTQTY,1,10)
261 S $P(REC,"|",23)=TOTQTY ;TOTAL DAILY DOSAGE QUANTITY - QUANTITY/DAYS SUPPLY
262 W "RXO|"_REC
263 W ! Q
264 ;
265 ;
266RXA(RXAC) ;
267 ;
268 ; RXAC - RXA counter
269 ;
270 N REC,LEX,VOECODE
271 S REC=""
272 S RXAC=RXAC+1
273 S $P(REC,"|",1)=RXAC ;Give Sub ID Counter
274 S $P(REC,"|",2)=RXAC ;Admin. Sub ID Counter
275 S DTTM=$G(IMMUNE(9000010.11,DFN,.03)),DTTM=$P(DTTM,"@"),%DT="T",X=DTTM D ^%DT
276 S DTTM=$P($$FMTHL7^XLFDT(Y),"-")
277 S $P(REC,"|",3)=DTTM
278 S $P(REC,"|",4)=DTTM
279 S SEARCH=$G(IMMUNE(9000010.11,DFN,.01)) D INFO^LEXA(SEARCH)
280 S VOECODE=$P($G(LEX("SEL","SRC",1)),"^",2)
281 S VOECODE=$S(SEARCH["FLU":16,SEARCH["PNEUM":33,1:"") ; THIS NEEDS TO BE A "CVX" CODE FROM HL7TABLE 0292
282 S $P(REC,"|",5)=VOECODE_"^"_SEARCH_"^CVX" ; CODE^TEXT^CODE SYSTEM^"CVX"
283 W "RXA|"_REC
284 W ! Q
285 ;
286 ;
287BTS(MSHC) ;Batch Trailer Segment
288 ;
289 W "BTS|",MSHC,"|||||"
290 W ! Q
291 ;
292 ;
293FTS(BTSC) ;File Trailer Segment
294 ;
295 W "FTS|",BHSC,"||"
296 W ! Q
297 ;
298 ;
299DTCALC(DATE,TIME) ;CONVERT DATE INTO HL7 DATE FORMAT.
300 ;
301 I DATE="" S DATE="T"
302 I TIME="" S TIME="N"
303 N %DT,X,DTTM
304 S %DT=DATE
305 S X=TIME
306 D ^%DT
307 S DTTM=$P($$FMTHL7^XLFDT(Y),"-")
308 Q DTTM
309 ;
310
Note: See TracBrowser for help on using the repository browser.