GMRCHL7 ;SLC/DCM,JFR - CONSULTS-->CPRS HL7 MESSAGING ; 10/15/02 15:23
;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,19,29**;DEC 27, 1997
;
; This routine invokes IA #872,#2638,#2698
;
;;Format the HL-7 Message header
Q
INIT S HLQ=""""""
S SEP1="|",SEP2="^",SEP3="~",SEP4="\",SEP5="&"
Q
MSH(X) ;Format MSH segment of HL-7 message.
;FROM=GMRC CONSULTS - the sending application
N X
I '$D(HLQ) D INIT
S X="MSH|^~\&|CONSULTS|"_$S(+$G(DUZ(2)):DUZ(2),1:$$SITE^VASITE())_"|||||ORM"
Q X
PID(GMRCIEN) ;Format the HL-7 PID segment
;GMRCIEN=IEN of consult from File 123
N X
S GMRCDPT=$P(^GMR(123,GMRCIEN,0),"^",2)
S GMRCPTN=$P($G(^DPT(GMRCDPT,0)),"^")
S X="PID|||"_+GMRCDPT_"||"_GMRCPTN
K GMRCDPT,GMRCPTN
Q X
PV1(GMRCIEN,RMBED,VISIT) ;Format the HL-7 PV1 segment
N GMRCSTS,SEP1,X,Y
S HOSPLOC=$P(^GMR(123,GMRCIEN,0),"^",4)
S VISIT=$$HL7DT(VISIT),GMRCSTS=$S($P(^GMR(123,GMRCIEN,0),"^",18)]"":$P(^(0),"^",18),HOSPLOC]"":"I",1:"O")
S X="PV1"_"||"_GMRCSTS_"|"_$S(HOSPLOC]"":HOSPLOC,1:"")_"^"_$S(RMBED]"":RMBED,1:"")_"|"_$S(VISIT]"":VISIT,1:"")
K Y,HOSPLOC,VISIT,GMRCSTS
Q X
NTE(NTE,ND) ;Format the HL-7 NTE segment
Q:'$D(NTE) Q:'$O(NTE(0))
S GMRCND=1,GMRCND1=0 D
.S GMRCND1=$O(NTE(GMRCND1)),@(MSG_"("_ND_")")=NTE(GMRCND1)
.F S GMRCND1=$O(NTE(GMRCND1)) Q:GMRCND1="" I NTE(GMRCND1)]"" S @(MSG_"("_ND_","_GMRCND_")")=NTE(GMRCND1),GMRCND=GMRCND+1
.Q
Q
EN(PATID,GMRCIEN,GMRCRTYP,RMBED,ORCTRL,GMRCPLCR,VISIT,GMRCOM,GRPUPD,ACTDT) ;;Main entry point
;PATID=DFN - Patients internal entry number from ^DPT(
;GMRCIEN=IEN of consult, from File 123
;RMBED=Hospital Room/Bed if patient is hospitalized
;ORCTRL=Code from HL-7 table 119 (Appendix A) Order Control Codes
;VISIT=Visit as a DATE/TIME in Fileman Format.
;GMRCPROV=Provider - IEN from file 200
;GMRCRTYP=consult type: GMRC REQUEST or GMRC CONSULT
;GMRCPLCR=who is entering the order ; usually passed as DUZ for new order, "" for existing order
;GMRCOM=comment array flag: 1 if there is comment array, 0 otherwise
;GMRCOM(0)=DA of where comment is located: ^GMR(123,IEN,40,DA,
;GRPUPD = group update of consults - sends nature as MAINTENANCE
;ACTDT = date/time of activity if sent
Q:'$L(ORCTRL)
K GMRCMSS
N MSG,MSH,PID,PV1,ORC,NTE,OBR,OBX,ZSV,GMRCA,GMRCURGI,GMRCPLI
N GMRCPR,GMRCSS,GMRCTYPE,ORCPLCR
S MSH="",MSH=$$MSH(MSH)
S PID=$$PID(GMRCIEN)
I ORCTRL'="Z@" S PV1=$$PV1(GMRCIEN,RMBED,VISIT)
D ORC(GMRCIEN,ORCTRL,GMRCPLCR,$G(GRPUPD),$G(ACTDT))
S ORCTRL=$P(ORCTRL,U)
I ORCTRL="Z@" S ORC=$P(ORC,SEP1,1,4)
D:ORCTRL'="Z@" OBR^GMRCHL72(GMRCIEN,$G(GMRCAUTH),$G(ACTDT))
;GMRCAUTH=principle results interpreter
D ZSV(GMRCIEN)
I $S(ORCTRL="SN":1,ORCTRL="RE":1,ORCTRL="XX":1,1:0) D OBX^GMRCHL72(GMRCIEN)
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)
D BLD(MSH,PID,$G(PV1),$G(ORC),$G(OBR),$G(ZSV),.OBX,.NTE,ORCTRL)
;M GMRCMSS=GMRCMSG ;HL-7 message debugging aid - remove from final version
D MSG^XQOR("GMRC EVSEND OR",.GMRCMSG)
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
Q
BLD(MSH,PID,PV1,ORC,OBR,ZSV,OBX,NTE,CTRLCD) ;Build the HL-7 message global to pass to OR
S MSG="GMRCMSG",ND=1
K @(MSG)
F J="MSH","PID","PV1" I $G(@J)]"" S @(MSG_"("_ND_")")=@J,ND=ND+1
I ORC]"" S @(MSG_"("_ND_")")=ORC,ND=ND+1
I $D(NTE),$O(NTE(0)) D NTE(.NTE,ND) S ND=ND+1
I OBR]"" S @(MSG_"("_ND_")")=OBR,ND=ND+1
I $L($G(ZSV)) S @(MSG_"("_ND_")")=ZSV,ND=ND+1
I $O(OBX("")) S OBXND=0 D
.F S OBXND=$O(OBX(OBXND)) Q:OBXND="" D
.. S @(MSG_"("_ND_")")=OBX(OBXND)
.. S GMRCND1=0 F S GMRCND1=$O(OBX(OBXND,GMRCND1)) Q:GMRCND1="" D
... S @(MSG_"("_ND_","_GMRCND1_")")=OBX(OBXND,GMRCND1)
.. S ND=ND+1
.Q
;I CTRLCD'="XX",$D(NTE),$O(NTE(0)) D NTE(.NTE,ND) S ND=ND+1
Q
HL7DT(DATE) ;Convert Fileman Date to HL-7 Date
I 'DATE Q ""
Q $$FMTHL7^XLFDT(DATE) ; use standard function
N X
S X="" I DATE S X=17000000+$P(DATE,".",1)_$P(DATE,".",2)
Q X
FMDATE(DATE) ;Convert HL-7 formatted date to a Fileman formatted date
I 'DATE Q ""
Q $$HL7TFM^XLFDT(DATE) ; use standard function
N X
ORC(GMRCIEN,GMRCTRL,ORCPLCR,MAINT,GMRCDT) ;Build ORC segment of HL-7 msg
;GMRCTRL=Order Control Code (table 119)
;GMRCIEN=File 123 IEN
;ORPLCR=GMRCPLCR - the person entering the order
;MAINT=1 - group update of requests
;GMRCDT=date/time of activity
N GMRCURG,ORCACT,ORCDT,ORCPRV,ORCDT,ORIEN,ORCSTS,STS,ORCNATR,QUANT,REAS
S REAS=$P(GMRCTRL,U,2),GMRCTRL=$P(GMRCTRL,U)
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)
S ORURG=$S(ORURG="EMERGENCY":"STAT",ORURG="NOW":"STAT",ORURG="OUTPATIENT":"ROUTINE",1:ORURG)
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:"")
S ORCDT=$$HL7DT(ORCDT)
I '$G(GMRCDT) S GMRCDT=$$NOW^XLFDT
S STS=$P(^GMR(123,GMRCIEN,0),"^",12)
S ORCACT=$P($G(^ORD(100.01,+STS,0)),U,1) S:'$L(ORCACT) ORCACT="NO STATUS"
S ORIEN=$P(^GMR(123,GMRCIEN,0),"^",3)
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")
S ORCNATR=""
I GMRCTRL="XX" S ORCNATR="S^SERVICE CORRECTION^99ORN^^"_REAS_"^"
I $G(MAINT) S ORCNATR="M^MAINTENANCE^99ORN^^^"
S QUANT=$S(GMRCURG]"":"^^^^^"_GMRCURG,1:"")
S GMRCDT=$$HL7DT(GMRCDT)
S ORC="ORC|"_GMRCTRL_"|"_$S(ORIEN]"":ORIEN_";1^OR",1:"")_"|"
S ORC=ORC_GMRCIEN_";GMRC^"_"GMRC"_"||"_ORCSTS_"||"_QUANT_"||"
S ORC=ORC_GMRCDT_"|"_ORCPLCR_"||"_ORCPRV_"|||"_ORCDT_"|"_ORCNATR
Q
ZSV(GMRCO) ;build ZSV segment for at least forward
N SERV,SERVNM,CTYPE
S SERV=$P($G(^GMR(123,GMRCO,0)),U,5)
I 'SERV Q
S SERVNM=$P($G(^GMR(123.5,SERV,0)),U)
S CTYPE=$G(^GMR(123,GMRCO,1.11))
I CTYPE=SERVNM S CTYPE=""
I $P(^GMR(123,GMRCO,0),U,8) S CTYPE=""
S ZSV="ZSV|^^^"_SERV_U_SERVNM_"^99CON|"_CTYPE
Q
GMRCHL7 ;SLC/DCM,JFR - CONSULTS-->CPRS HL7 MESSAGING ; 10/15/02 15:23
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,19,29**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #872,#2638,#2698
+4 ;
+5 ;;Format the HL-7 Message header
+6 QUIT
INIT SET HLQ=""""""
+1 SET SEP1="|"
SET SEP2="^"
SET SEP3="~"
SET SEP4="\"
SET SEP5="&"
+2 QUIT
MSH(X) ;Format MSH segment of HL-7 message.
+1 ;FROM=GMRC CONSULTS - the sending application
+2 NEW X
+3 IF '$DATA(HLQ)
DO INIT
+4 SET X="MSH|^~\&|CONSULTS|"_$SELECT(+$GET(DUZ(2)):DUZ(2),1:$$SITE^VASITE())_"|||||ORM"
+5 QUIT X
PID(GMRCIEN) ;Format the HL-7 PID segment
+1 ;GMRCIEN=IEN of consult from File 123
+2 NEW X
+3 SET GMRCDPT=$PIECE(^GMR(123,GMRCIEN,0),"^",2)
+4 SET GMRCPTN=$PIECE($GET(^DPT(GMRCDPT,0)),"^")
+5 SET X="PID|||"_+GMRCDPT_"||"_GMRCPTN
+6 KILL GMRCDPT,GMRCPTN
+7 QUIT X
PV1(GMRCIEN,RMBED,VISIT) ;Format the HL-7 PV1 segment
+1 NEW GMRCSTS,SEP1,X,Y
+2 SET HOSPLOC=$PIECE(^GMR(123,GMRCIEN,0),"^",4)
+3 SET VISIT=$$HL7DT(VISIT)
SET GMRCSTS=$SELECT($PIECE(^GMR(123,GMRCIEN,0),"^",18)]"":$PIECE(^(0),"^",18),HOSPLOC]"":"I",1:"O")
+4 SET X="PV1"_"||"_GMRCSTS_"|"_$SELECT(HOSPLOC]"":HOSPLOC,1:"")_"^"_$SELECT(RMBED]"":RMBED,1:"")_"|"_$SELECT(VISIT]"":VISIT,1:"")
+5 KILL Y,HOSPLOC,VISIT,GMRCSTS
+6 QUIT X
NTE(NTE,ND) ;Format the HL-7 NTE segment
+1 IF '$DATA(NTE)
QUIT
IF '$ORDER(NTE(0))
QUIT
+2 SET GMRCND=1
SET GMRCND1=0
Begin DoDot:1
+3 SET GMRCND1=$ORDER(NTE(GMRCND1))
SET @(MSG_"("_ND_")")=NTE(GMRCND1)
+4 FOR
SET GMRCND1=$ORDER(NTE(GMRCND1))
IF GMRCND1=""
QUIT
IF NTE(GMRCND1)]""
SET @(MSG_"("_ND_","_GMRCND_")")=NTE(GMRCND1)
SET GMRCND=GMRCND+1
+5 QUIT
End DoDot:1
+6 QUIT
EN(PATID,GMRCIEN,GMRCRTYP,RMBED,ORCTRL,GMRCPLCR,VISIT,GMRCOM,GRPUPD,ACTDT) ;;Main entry point
+1 ;PATID=DFN - Patients internal entry number from ^DPT(
+2 ;GMRCIEN=IEN of consult, from File 123
+3 ;RMBED=Hospital Room/Bed if patient is hospitalized
+4 ;ORCTRL=Code from HL-7 table 119 (Appendix A) Order Control Codes
+5 ;VISIT=Visit as a DATE/TIME in Fileman Format.
+6 ;GMRCPROV=Provider - IEN from file 200
+7 ;GMRCRTYP=consult type: GMRC REQUEST or GMRC CONSULT
+8 ;GMRCPLCR=who is entering the order ; usually passed as DUZ for new order, "" for existing order
+9 ;GMRCOM=comment array flag: 1 if there is comment array, 0 otherwise
+10 ;GMRCOM(0)=DA of where comment is located: ^GMR(123,IEN,40,DA,
+11 ;GRPUPD = group update of consults - sends nature as MAINTENANCE
+12 ;ACTDT = date/time of activity if sent
+13 IF '$LENGTH(ORCTRL)
QUIT
+14 KILL GMRCMSS
+15 NEW MSG,MSH,PID,PV1,ORC,NTE,OBR,OBX,ZSV,GMRCA,GMRCURGI,GMRCPLI
+16 NEW GMRCPR,GMRCSS,GMRCTYPE,ORCPLCR
+17 SET MSH=""
SET MSH=$$MSH(MSH)
+18 SET PID=$$PID(GMRCIEN)
+19 IF ORCTRL'="Z@"
SET PV1=$$PV1(GMRCIEN,RMBED,VISIT)
+20 DO ORC(GMRCIEN,ORCTRL,GMRCPLCR,$GET(GRPUPD),$GET(ACTDT))
+21 SET ORCTRL=$PIECE(ORCTRL,U)
+22 IF ORCTRL="Z@"
SET ORC=$PIECE(ORC,SEP1,1,4)
+23 IF ORCTRL'="Z@"
DO OBR^GMRCHL72(GMRCIEN,$GET(GMRCAUTH),$GET(ACTDT))
+24 ;GMRCAUTH=principle results interpreter
+25 DO ZSV(GMRCIEN)
+26 IF $SELECT(ORCTRL="SN":1,ORCTRL="RE":1,ORCTRL="XX":1,1:0)
DO OBX^GMRCHL72(GMRCIEN)
+27 IF $SELECT(ORCTRL="OC":1,ORCTRL="OD":1,ORCTRL="XX":1,ORCTRL="SC":1,1:0)
IF $GET(GMRCOM(0))
DO NTE^GMRCHL72(GMRCIEN,.GMRCOM,ORCTRL)
+28 DO BLD(MSH,PID,$GET(PV1),$GET(ORC),$GET(OBR),$GET(ZSV),.OBX,.NTE,ORCTRL)
+29 ;M GMRCMSS=GMRCMSG ;HL-7 message debugging aid - remove from final version
+30 DO MSG^XQOR("GMRC EVSEND OR",.GMRCMSG)
+31 KILL GMRCND,GMRCND1,GMRCMSG,GMRCNOD,GMRCORFN,GMRCPLI,GMRCPRI,HL7DT,HLQ,J,ND,ND1,ND2,NOTIFY,OBXND,OBXNO,ORCACT,ORCDT,ORURG,SEP1,SEP2,SEP3,SEP4,SEP5
+32 QUIT
BLD(MSH,PID,PV1,ORC,OBR,ZSV,OBX,NTE,CTRLCD) ;Build the HL-7 message global to pass to OR
+1 SET MSG="GMRCMSG"
SET ND=1
+2 KILL @(MSG)
+3 FOR J="MSH","PID","PV1"
IF $GET(@J)]""
SET @(MSG_"("_ND_")")=@J
SET ND=ND+1
+4 IF ORC]""
SET @(MSG_"("_ND_")")=ORC
SET ND=ND+1
+5 IF $DATA(NTE)
IF $ORDER(NTE(0))
DO NTE(.NTE,ND)
SET ND=ND+1
+6 IF OBR]""
SET @(MSG_"("_ND_")")=OBR
SET ND=ND+1
+7 IF $LENGTH($GET(ZSV))
SET @(MSG_"("_ND_")")=ZSV
SET ND=ND+1
+8 IF $ORDER(OBX(""))
SET OBXND=0
Begin DoDot:1
+9 FOR
SET OBXND=$ORDER(OBX(OBXND))
IF OBXND=""
QUIT
Begin DoDot:2
+10 SET @(MSG_"("_ND_")")=OBX(OBXND)
+11 SET GMRCND1=0
FOR
SET GMRCND1=$ORDER(OBX(OBXND,GMRCND1))
IF GMRCND1=""
QUIT
Begin DoDot:3
+12 SET @(MSG_"("_ND_","_GMRCND1_")")=OBX(OBXND,GMRCND1)
End DoDot:3
+13 SET ND=ND+1
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;I CTRLCD'="XX",$D(NTE),$O(NTE(0)) D NTE(.NTE,ND) S ND=ND+1
+16 QUIT
HL7DT(DATE) ;Convert Fileman Date to HL-7 Date
+1 IF 'DATE
QUIT ""
+2 ; use standard function
QUIT $$FMTHL7^XLFDT(DATE)
+3 NEW X
+4 SET X=""
IF DATE
SET X=17000000+$PIECE(DATE,".",1)_$PIECE(DATE,".",2)
+5 QUIT X
FMDATE(DATE) ;Convert HL-7 formatted date to a Fileman formatted date
+1 IF 'DATE
QUIT ""
+2 ; use standard function
QUIT $$HL7TFM^XLFDT(DATE)
+3 NEW X
ORC(GMRCIEN,GMRCTRL,ORCPLCR,MAINT,GMRCDT) ;Build ORC segment of HL-7 msg
+1 ;GMRCTRL=Order Control Code (table 119)
+2 ;GMRCIEN=File 123 IEN
+3 ;ORPLCR=GMRCPLCR - the person entering the order
+4 ;MAINT=1 - group update of requests
+5 ;GMRCDT=date/time of activity
+6 NEW GMRCURG,ORCACT,ORCDT,ORCPRV,ORCDT,ORIEN,ORCSTS,STS,ORCNATR,QUANT,REAS
+7 SET REAS=$PIECE(GMRCTRL,U,2)
SET GMRCTRL=$PIECE(GMRCTRL,U)
+8 SET ORCDT=$PIECE(^GMR(123,GMRCIEN,0),"^",7)
SET ORCPRV=$PIECE(^GMR(123,GMRCIEN,0),"^",14)
SET ORURG=$PIECE(^(0),"^",9)
SET ORURG=$SELECT(ORURG]"":$PIECE(^ORD(101,ORURG,0),"^",1),1:"")
IF ORURG]""
SET ORURG=$PIECE(ORURG," - ",2)
+9 SET ORURG=$SELECT(ORURG="EMERGENCY":"STAT",ORURG="NOW":"STAT",ORURG="OUTPATIENT":"ROUTINE",1:ORURG)
+10 IF ORURG=""
SET GMRCURG=""
IF ORURG]""
SET GMRCURG=$ORDER(^ORD(101.42,"B",ORURG,0))
SET GMRCURG=$SELECT(+GMRCURG:$PIECE(^ORD(101.42,GMRCURG,0),"^",2),1:"")
+11 SET ORCDT=$$HL7DT(ORCDT)
+12 IF '$GET(GMRCDT)
SET GMRCDT=$$NOW^XLFDT
+13 SET STS=$PIECE(^GMR(123,GMRCIEN,0),"^",12)
+14 SET ORCACT=$PIECE($GET(^ORD(100.01,+STS,0)),U,1)
IF '$LENGTH(ORCACT)
SET ORCACT="NO STATUS"
+15 SET ORIEN=$PIECE(^GMR(123,GMRCIEN,0),"^",3)
+16 SET ORCSTS=$SELECT(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")
+17 SET ORCNATR=""
+18 IF GMRCTRL="XX"
SET ORCNATR="S^SERVICE CORRECTION^99ORN^^"_REAS_"^"
+19 IF $GET(MAINT)
SET ORCNATR="M^MAINTENANCE^99ORN^^^"
+20 SET QUANT=$SELECT(GMRCURG]"":"^^^^^"_GMRCURG,1:"")
+21 SET GMRCDT=$$HL7DT(GMRCDT)
+22 SET ORC="ORC|"_GMRCTRL_"|"_$SELECT(ORIEN]"":ORIEN_";1^OR",1:"")_"|"
+23 SET ORC=ORC_GMRCIEN_";GMRC^"_"GMRC"_"||"_ORCSTS_"||"_QUANT_"||"
+24 SET ORC=ORC_GMRCDT_"|"_ORCPLCR_"||"_ORCPRV_"|||"_ORCDT_"|"_ORCNATR
+25 QUIT
ZSV(GMRCO) ;build ZSV segment for at least forward
+1 NEW SERV,SERVNM,CTYPE
+2 SET SERV=$PIECE($GET(^GMR(123,GMRCO,0)),U,5)
+3 IF 'SERV
QUIT
+4 SET SERVNM=$PIECE($GET(^GMR(123.5,SERV,0)),U)
+5 SET CTYPE=$GET(^GMR(123,GMRCO,1.11))
+6 IF CTYPE=SERVNM
SET CTYPE=""
+7 IF $PIECE(^GMR(123,GMRCO,0),U,8)
SET CTYPE=""
+8 SET ZSV="ZSV|^^^"_SERV_U_SERVNM_"^99CON|"_CTYPE
+9 QUIT
