source: FOIAVistA/tag/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCHL7.m@ 628

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