Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCHL7

GMRCHL7.m

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