source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCHL7.m@ 1593

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1GMRCHL7 ;SLC/DCM,JFR - CONSULTS-->CPRS HL7 MESSAGING ; 10/15/02 15:23
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,19,29**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #872,#2638,#2698
5 ;
6 ;;Format the HL-7 Message header
7 Q
8INIT S HLQ=""""""
9 S SEP1="|",SEP2="^",SEP3="~",SEP4="\",SEP5="&"
10 Q
11MSH(X) ;Format MSH segment of HL-7 message.
12 ;FROM=GMRC CONSULTS - the sending application
13 N X
14 I '$D(HLQ) D INIT
15 S X="MSH|^~\&|CONSULTS|"_$S(+$G(DUZ(2)):DUZ(2),1:$$SITE^VASITE())_"|||||ORM"
16 Q X
17PID(GMRCIEN) ;Format the HL-7 PID segment
18 ;GMRCIEN=IEN of consult from File 123
19 N X
20 S GMRCDPT=$P(^GMR(123,GMRCIEN,0),"^",2)
21 S GMRCPTN=$P($G(^DPT(GMRCDPT,0)),"^")
22 S X="PID|||"_+GMRCDPT_"||"_GMRCPTN
23 K GMRCDPT,GMRCPTN
24 Q X
25PV1(GMRCIEN,RMBED,VISIT) ;Format the HL-7 PV1 segment
26 N GMRCSTS,SEP1,X,Y
27 S HOSPLOC=$P(^GMR(123,GMRCIEN,0),"^",4)
28 S VISIT=$$HL7DT(VISIT),GMRCSTS=$S($P(^GMR(123,GMRCIEN,0),"^",18)]"":$P(^(0),"^",18),HOSPLOC]"":"I",1:"O")
29 S X="PV1"_"||"_GMRCSTS_"|"_$S(HOSPLOC]"":HOSPLOC,1:"")_"^"_$S(RMBED]"":RMBED,1:"")_"|"_$S(VISIT]"":VISIT,1:"")
30 K Y,HOSPLOC,VISIT,GMRCSTS
31 Q X
32NTE(NTE,ND) ;Format the HL-7 NTE segment
33 Q:'$D(NTE) Q:'$O(NTE(0))
34 S GMRCND=1,GMRCND1=0 D
35 .S GMRCND1=$O(NTE(GMRCND1)),@(MSG_"("_ND_")")=NTE(GMRCND1)
36 .F S GMRCND1=$O(NTE(GMRCND1)) Q:GMRCND1="" I NTE(GMRCND1)]"" S @(MSG_"("_ND_","_GMRCND_")")=NTE(GMRCND1),GMRCND=GMRCND+1
37 .Q
38 Q
39EN(PATID,GMRCIEN,GMRCRTYP,RMBED,ORCTRL,GMRCPLCR,VISIT,GMRCOM,GRPUPD,ACTDT) ;;Main entry point
40 ;PATID=DFN - Patients internal entry number from ^DPT(
41 ;GMRCIEN=IEN of consult, from File 123
42 ;RMBED=Hospital Room/Bed if patient is hospitalized
43 ;ORCTRL=Code from HL-7 table 119 (Appendix A) Order Control Codes
44 ;VISIT=Visit as a DATE/TIME in Fileman Format.
45 ;GMRCPROV=Provider - IEN from file 200
46 ;GMRCRTYP=consult type: GMRC REQUEST or GMRC CONSULT
47 ;GMRCPLCR=who is entering the order ; usually passed as DUZ for new order, "" for existing order
48 ;GMRCOM=comment array flag: 1 if there is comment array, 0 otherwise
49 ;GMRCOM(0)=DA of where comment is located: ^GMR(123,IEN,40,DA,
50 ;GRPUPD = group update of consults - sends nature as MAINTENANCE
51 ;ACTDT = date/time of activity if sent
52 Q:'$L(ORCTRL)
53 K GMRCMSS
54 N MSG,MSH,PID,PV1,ORC,NTE,OBR,OBX,ZSV,GMRCA,GMRCURGI,GMRCPLI
55 N GMRCPR,GMRCSS,GMRCTYPE,ORCPLCR
56 S MSH="",MSH=$$MSH(MSH)
57 S PID=$$PID(GMRCIEN)
58 I ORCTRL'="Z@" S PV1=$$PV1(GMRCIEN,RMBED,VISIT)
59 D ORC(GMRCIEN,ORCTRL,GMRCPLCR,$G(GRPUPD),$G(ACTDT))
60 S ORCTRL=$P(ORCTRL,U)
61 I ORCTRL="Z@" S ORC=$P(ORC,SEP1,1,4)
62 D:ORCTRL'="Z@" OBR^GMRCHL72(GMRCIEN,$G(GMRCAUTH),$G(ACTDT))
63 ;GMRCAUTH=principle results interpreter
64 D ZSV(GMRCIEN)
65 I $S(ORCTRL="SN":1,ORCTRL="RE":1,ORCTRL="XX":1,1:0) D OBX^GMRCHL72(GMRCIEN)
66 I $S(ORCTRL="OC":1,ORCTRL="OD":1,ORCTRL="XX":1,ORCTRL="SC":1,1:0),$G(GMRCOM(0)) D NTE^GMRCHL72(GMRCIEN,.GMRCOM,ORCTRL)
67 D BLD(MSH,PID,$G(PV1),$G(ORC),$G(OBR),$G(ZSV),.OBX,.NTE,ORCTRL)
68 ;M GMRCMSS=GMRCMSG ;HL-7 message debugging aid - remove from final version
69 D MSG^XQOR("GMRC EVSEND OR",.GMRCMSG)
70 K GMRCND,GMRCND1,GMRCMSG,GMRCNOD,GMRCORFN,GMRCPLI,GMRCPRI,HL7DT,HLQ,J,ND,ND1,ND2,NOTIFY,OBXND,OBXNO,ORCACT,ORCDT,ORURG,SEP1,SEP2,SEP3,SEP4,SEP5
71 Q
72BLD(MSH,PID,PV1,ORC,OBR,ZSV,OBX,NTE,CTRLCD) ;Build the HL-7 message global to pass to OR
73 S MSG="GMRCMSG",ND=1
74 K @(MSG)
75 F J="MSH","PID","PV1" I $G(@J)]"" S @(MSG_"("_ND_")")=@J,ND=ND+1
76 I ORC]"" S @(MSG_"("_ND_")")=ORC,ND=ND+1
77 I $D(NTE),$O(NTE(0)) D NTE(.NTE,ND) S ND=ND+1
78 I OBR]"" S @(MSG_"("_ND_")")=OBR,ND=ND+1
79 I $L($G(ZSV)) S @(MSG_"("_ND_")")=ZSV,ND=ND+1
80 I $O(OBX("")) S OBXND=0 D
81 .F S OBXND=$O(OBX(OBXND)) Q:OBXND="" D
82 .. S @(MSG_"("_ND_")")=OBX(OBXND)
83 .. S GMRCND1=0 F S GMRCND1=$O(OBX(OBXND,GMRCND1)) Q:GMRCND1="" D
84 ... S @(MSG_"("_ND_","_GMRCND1_")")=OBX(OBXND,GMRCND1)
85 .. S ND=ND+1
86 .Q
87 ;I CTRLCD'="XX",$D(NTE),$O(NTE(0)) D NTE(.NTE,ND) S ND=ND+1
88 Q
89HL7DT(DATE) ;Convert Fileman Date to HL-7 Date
90 I 'DATE Q ""
91 Q $$FMTHL7^XLFDT(DATE) ; use standard function
92 N X
93 S X="" I DATE S X=17000000+$P(DATE,".",1)_$P(DATE,".",2)
94 Q X
95FMDATE(DATE) ;Convert HL-7 formatted date to a Fileman formatted date
96 I 'DATE Q ""
97 Q $$HL7TFM^XLFDT(DATE) ; use standard function
98 N X
99ORC(GMRCIEN,GMRCTRL,ORCPLCR,MAINT,GMRCDT) ;Build ORC segment of HL-7 msg
100 ;GMRCTRL=Order Control Code (table 119)
101 ;GMRCIEN=File 123 IEN
102 ;ORPLCR=GMRCPLCR - the person entering the order
103 ;MAINT=1 - group update of requests
104 ;GMRCDT=date/time of activity
105 N GMRCURG,ORCACT,ORCDT,ORCPRV,ORCDT,ORIEN,ORCSTS,STS,ORCNATR,QUANT,REAS
106 S REAS=$P(GMRCTRL,U,2),GMRCTRL=$P(GMRCTRL,U)
107 S ORCDT=$P(^GMR(123,GMRCIEN,0),"^",7),ORCPRV=$P(^GMR(123,GMRCIEN,0),"^",14),ORURG=$P(^(0),"^",9),ORURG=$S(ORURG]"":$P(^ORD(101,ORURG,0),"^",1),1:"") S:ORURG]"" ORURG=$P(ORURG," - ",2)
108 S ORURG=$S(ORURG="EMERGENCY":"STAT",ORURG="NOW":"STAT",ORURG="OUTPATIENT":"ROUTINE",1:ORURG)
109 S:ORURG="" GMRCURG="" I ORURG]"" S GMRCURG=$O(^ORD(101.42,"B",ORURG,0)),GMRCURG=$S(+GMRCURG:$P(^ORD(101.42,GMRCURG,0),"^",2),1:"")
110 S ORCDT=$$HL7DT(ORCDT)
111 I '$G(GMRCDT) S GMRCDT=$$NOW^XLFDT
112 S STS=$P(^GMR(123,GMRCIEN,0),"^",12)
113 S ORCACT=$P($G(^ORD(100.01,+STS,0)),U,1) S:'$L(ORCACT) ORCACT="NO STATUS"
114 S ORIEN=$P(^GMR(123,GMRCIEN,0),"^",3)
115 S ORCSTS=$S(STS=1:"DC",STS=2:"CM",STS=5:"IP",STS=6:"SC",STS=9:"A",STS=12:"RP",STS=13:"CA",STS=8:"ZC",1:"IP")
116 S ORCNATR=""
117 I GMRCTRL="XX" S ORCNATR="S^SERVICE CORRECTION^99ORN^^"_REAS_"^"
118 I $G(MAINT) S ORCNATR="M^MAINTENANCE^99ORN^^^"
119 S QUANT=$S(GMRCURG]"":"^^^^^"_GMRCURG,1:"")
120 S GMRCDT=$$HL7DT(GMRCDT)
121 S ORC="ORC|"_GMRCTRL_"|"_$S(ORIEN]"":ORIEN_";1^OR",1:"")_"|"
122 S ORC=ORC_GMRCIEN_";GMRC^"_"GMRC"_"||"_ORCSTS_"||"_QUANT_"||"
123 S ORC=ORC_GMRCDT_"|"_ORCPLCR_"||"_ORCPRV_"|||"_ORCDT_"|"_ORCNATR
124 Q
125ZSV(GMRCO) ;build ZSV segment for at least forward
126 N SERV,SERVNM,CTYPE
127 S SERV=$P($G(^GMR(123,GMRCO,0)),U,5)
128 I 'SERV Q
129 S SERVNM=$P($G(^GMR(123.5,SERV,0)),U)
130 S CTYPE=$G(^GMR(123,GMRCO,1.11))
131 I CTYPE=SERVNM S CTYPE=""
132 I $P(^GMR(123,GMRCO,0),U,8) S CTYPE=""
133 S ZSV="ZSV|^^^"_SERV_U_SERVNM_"^99CON|"_CTYPE
134 Q
Note: See TracBrowser for help on using the repository browser.