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

GMRCHL7A.m

Go to the documentation of this file.
  1. GMRCHL7A ;SLC/DCM,MA - Receive HL-7 Message from OERR ;Sep 15, 2020@06:44:39
  1. ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,21,22,33,68,66,73,81,145**;DEC 27, 1997;Build 18
  1. ;
  1. ;ICRs
  1. ;;GLOBALS/FILES #872(FILE 101 ^ORD(101))
  1. ;;ROUTINES #2053(DIE)
  1. ;Patch 145 - adds processing of DST ID to ZSV segment
  1. ;
  1. URG(X) ;Return Urgency give Z-code from HL-7 segment; see ORC+9
  1. S X=$S(X="S":"STAT",X="R":"ROUTINE",X="ZT":"TODAY",X="Z24":"WITHIN 24 HOURS",X="Z48":"WITHIN 48 HOURS",X="Z72":"WITHIN 72 HOURS",X="ZW":"WITHIN 1 WEEK",X="ZM":"WITHIN 1 MONTH",X="ZNA":"NEXT AVAILABLE",1:X)
  1. I $E(X,1)="Z" S X=$S(X="ZT":"TODAY",X="ZE":"EMERGENCY",1:"")
  1. Q X
  1. ;
  1. ORC(GMRCORC) ;Get fields from ORC segment and set into GMRC variables
  1. ;GMRCTRLC=ORC control code from HL7 Table 119
  1. ;GMRCURGI=priority/urgency GMRCPLCR=who entered the order
  1. ;GMRCORNP=provider GMRCNATO=nature of order
  1. ;GMRCAD=date of request GMRCOCR=order request reason
  1. ;GMRCORFN=oe/rr file number GMRCO=file 123 IEN - if not a new order
  1. ;GMRCS38=order status - taken from Table 38, HL7 standard
  1. ;GMRCERDT=clinically indicated date
  1. S GMRCTRLC=$P(GMRCORC,SEP1,2),GMRCORFN=$P(GMRCORC,SEP1,3),GMRCORFN=$P($P(GMRCORFN,SEP2,1),";",1),GMRCAPP=$P($P(GMRCORC,SEP1,3),SEP2,2)
  1. S GMRCS38=$P(GMRCORC,SEP1,6),GMRCURGI=$P($P(GMRCORC,SEP1,8),SEP2,6),GMRCPLCR=$P(GMRCORC,SEP1,11),GMRCORNP=$P(GMRCORC,SEP1,13)
  1. I $L(GMRCURGI) S GMRCURGI="GMRCURGENCY - "_$$URG(GMRCURGI),GMRCURGI=$O(^ORD(101,"B",GMRCURGI,0))
  1. S GMRCERDT=$P($P(GMRCORC,SEP1,8),SEP2,4),GMRCERDT=$$FMDATE^GMRCHL7($G(GMRCERDT))
  1. S GMRCO=+$P($P(GMRCORC,SEP1,4),SEP2,1)
  1. S GMRCODT=$P(GMRCORC,SEP1,16),GMRCAD=$$FMDATE^GMRCHL7(GMRCODT)
  1. S GMRCOCR=$P(GMRCORC,SEP1,17),GMRCNATO=$P(GMRCOCR,SEP2,5)
  1. Q
  1. OBR(GMRCOBR) ;Get fields from OBR segment and set into GMRC variables
  1. ;GMRCTYPE=GMRC consult or GMRC request GMRCSS=To Service
  1. ;GMRCPLI=place of consultation GMRCODT=observation date/time
  1. ;GMRCATN=person to alert (attention) GMRCSTDT=status change date/time
  1. ;GMRCS123=results status (table 123) GMRCINTR=results interpreter
  1. ;GMRCPRI=procedure from file ^ORD(101,
  1. ;GMRCXMF=foreign consult service
  1. ; a flag that tells the HL7 routine that
  1. ; consults does not need to return CPRS a file
  1. ; IEN for file 123. See routine ^GMRCXMF
  1. S GMRCPR=$P($P(GMRCOBR,SEP1,5),SEP2,6)
  1. S GMRCTYPE=$S(GMRCPR="99PRC":"P",1:"C")
  1. S GMRCPRI="",GMRCSS=""
  1. I GMRCPR="99PRC" D
  1. . S GMRCPRI=$P($P(GMRCOBR,SEP1,5),SEP2,4)
  1. . S GMRCPRI=$S(+GMRCPRI:GMRCPRI_";GMR(123.3,",1:"")
  1. . Q
  1. ;
  1. S GMRCOTXT=$P($P(GMRCOBR,SEP1,5),SEP2,5) ;consult type or service name
  1. S GMRCODT=$P(GMRCOBR,SEP1,7) I GMRCODT]"" S GMRCODT=$$FMDATE^GMRCHL7(GMRCODT)
  1. S GMRCPLI=$P(GMRCOBR,SEP1,19) I GMRCPLI]"" S GMRCPLI="GMRCPLACE - "_$S(GMRCPLI="OC":"ON CALL",GMRCPLI="B":"BEDSIDE",GMRCPLI="E":"EMERGENCY ROOM",1:GMRCPLI),GMRCPLI=$O(^ORD(101,"B",GMRCPLI,0))
  1. S GMRCATN=$P(GMRCOBR,SEP1,20),GMRCSTDT=$P(GMRCOBR,SEP1,23),GMRCSTDT=$$FMDATE^GMRCHL7(GMRCSTDT)
  1. S GMRCS123=$P(GMRCOBR,SEP1,26),GMRCINTR=$P(GMRCOBR,SEP1,33)
  1. Q
  1. ZSV(GMRCZSV) ;Get service from ZSV segment and set into GMRCSS
  1. S GMRCZSS=$P($P(GMRCZSV,SEP1,2),SEP2,4)
  1. I +$G(GMRCZSS) S GMRCSS=+$G(GMRCZSS) ;Set the service if ZSV provided
  1. I $L($P(GMRCZSV,"|",3)) S GMRCOTXT=$P(GMRCZSV,"|",3) ;consult type
  1. I $L($P(GMRCZSV,"|",4)) S GMRCDSID=$P(GMRCZSV,"|",4) ;DST ID
  1. Q
  1. OBX(GMRCOBX) ;Get fields from OBX segment and set into GMRC variables
  1. ;GMRCVTYP=Value type from table 123 - i.e. TX(text), ST(string data),etc.
  1. ;GMRCOID=observation id identifying value in seg. 5
  1. ;GMRCVAL=observation value coded by segment 3
  1. ;GMRCPRDG=provisional diagnosis
  1. ; free text or code^free text^I9C
  1. S GMRCMSG=MSG(GMRCOBX)
  1. S GMRCVTYP=$P(GMRCMSG,SEP1,3),GMRCOID=$P($P(GMRCMSG,SEP1,4),SEP2,2),GMRCVAL=$P(GMRCOID,SEP2,3)
  1. I GMRCOID="REASON FOR REQUEST" D
  1. .S GMRCRFQ(1)=$P(GMRCMSG,SEP1,6)
  1. .S LN=0 F S LN=$O(MSG(GMRCOBX,LN)) Q:LN="" S GMRCRFQ(LN+1)=MSG(GMRCOBX,LN)
  1. .Q
  1. I GMRCOID="PROVISIONAL DIAGNOSIS" D Q
  1. . I GMRCVTYP="TX" D Q
  1. .. S GMRCPRDG=$P(GMRCMSG,SEP1,6)
  1. .. S GMRCPRDG=$TR(GMRCPRDG,$C(9,10,13)," ") Q
  1. . I GMRCVTYP="CE" D Q
  1. .. N PRDXSEG S PRDXSEG=$P(GMRCMSG,SEP1,6)
  1. .. S GMRCPRDG=$TR($P(PRDXSEG,"^",2),$C(9,10,13),"") ;_"("_$P(PRDXSEG,"^")_")" WAT/73 no longer appending (code number) to end of diagnosis text
  1. .. S GMRCPRCD=$P(PRDXSEG,"^")
  1. I GMRCOID["COMMENT" D
  1. .S GMRCCMT(1)=$P(GMRCMSG,SEP1,6)
  1. .S LN=0 F S LN=$O(MSG(GMRCOBX,LN)) Q:LN="" S GMRCCMT(LN+1)=MSG(GMRCOBX,LN)
  1. .Q
  1. K LN
  1. Q
  1. EN(MSG) ;Entry point to routine
  1. ;MSG = local array which contains the HL-7 segments
  1. ;GMRCSEND=sending application GMRCFAC=sending facility
  1. ;GMRCMTP=message type
  1. N DFN,GMRCACT,GMRCADD,GMRCFAC,GMRCMTP,GMRCPNM,GMRCO,GMRCOCR,GMRCORNP
  1. N GMRCORFN,GMRCPLCR,GMRCRB,GMRCSEND,GMRCSTS,GMRCTRLC,GMRCWARD,ORIFN
  1. N GMRCTRLC,GMRCAD,ORC,GMRCSBR,GMRCZSS,GMRCSS,GMRCOTXT,GMRCPRCD
  1. N GMRCREJ,GMRCRECV,GMRCERDT,GMRCNLTD,GMRCDSID
  1. S GMRCMSG="",GMRCNOD=0 F S GMRCNOD=$O(MSG(GMRCNOD)) Q:GMRCNOD="" S GMRCMSG=MSG(GMRCNOD) I $E(GMRCMSG,1,3)="MSH" D INIT^GMRCHL7U(GMRCMSG) D Q
  1. .S GMRCSEND=$P(GMRCMSG,SEP1,3),GMRCFAC=$P(GMRCMSG,SEP1,4)
  1. .S GMRCMTP=$P(GMRCMSG,SEP1,9),GMRCRECV=$P(GMRCMSG,SEP1,5)
  1. .Q
  1. I $G(GMRCRECV)'="CONSULTS" Q ;not intended for Consults
  1. S GMRCMSG="",GMRCNOD=0
  1. F S GMRCNOD=$O(MSG(GMRCNOD)) Q:GMRCNOD="" S GMRCMSG=MSG(GMRCNOD) D
  1. .I $E(GMRCMSG,1,3)="PID" D PID^GMRCHL7U(GMRCMSG) Q
  1. .I $E(GMRCMSG,1,3)="PV1" D PV1^GMRCHL7U(GMRCMSG) Q
  1. .I $E(GMRCMSG,1,3)="ORC" D ORC(GMRCMSG) Q
  1. .I $E(GMRCMSG,1,3)="OBR" D OBR(GMRCMSG) Q
  1. .I $E(GMRCMSG,1,3)="ZSV" D ZSV(GMRCMSG) Q
  1. .I $E(GMRCMSG,1,3)="OBX" D OBX(GMRCNOD) Q
  1. .I $E(GMRCMSG,1,3)="NTE" D NTE^GMRCHL7U(.MSG,GMRCNOD,GMRCO,GMRCTRLC) Q
  1. .I $E(GMRCMSG,1,3)="ZXX" S GMRCOFN=+$P(GMRCMSG,SEP1,2) K MSG(GMRCNOD) Q
  1. .Q
  1. ;Note, ZXX is not used yet; planned for future sharing consults with foreign facilities.
  1. I '$D(GMRCTRLC) D EXIT^GMRCHL7U Q
  1. I GMRCTRLC="Z@" D CPRSPURG^GMRCPURG(+GMRCO),EXIT^GMRCHL7U Q
  1. I GMRCTRLC="NW" D NEW^GMRCHL7B(.GMRCREJ) D
  1. . I $G(GMRCO) D RETURN^GMRCHL7U(GMRCO,GMRCTRLC) Q
  1. . D REJECT^GMRCHL7U(.MSG,$G(GMRCREJ))
  1. I '$D(GMRCO) D EXIT^GMRCHL7U Q
  1. I $S(GMRCTRLC="CA":1,GMRCTRLC="DC":1,1:0) D DC^GMRCHL7B(GMRCO,GMRCTRLC),RETURN^GMRCHL7U(GMRCO,GMRCTRLC)
  1. I GMRCTRLC="NA" D RTN(GMRCORFN,GMRCO)
  1. I GMRCTRLC="XX" D MODIFY^GMRCHL7B ;Not currently returned by CPRS
  1. ; If consults sends an XX, CPRS returns an NA.
  1. D EXIT^GMRCHL7U
  1. Q
  1. RTN(GMRCORN,DA) ;Put ^OR(100, ien for order into ^GMR(123,
  1. S DIE="^GMR(123,",DR=".03////^S X=GMRCORN"
  1. L +^GMR(123,DA):$S($G(DILOCKTM)>0:DILOCKTM,1:5) D ^DIE L -^GMR(123,DA) ;wat/66 add lock timeout
  1. K DIE,DR
  1. Q