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