GMRCHL7U ;SLC/DCM,MA - Utilities assoc. with HL7 messages ; 12/1/20 4:51pm
;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,21,22,29,66,145,168**;DEC 27, 1997;Build 3
; Patch #21 added more variables to in line tage EXIT.
;
; This routine invokes IA #872(FILE 101 ^ORD(100)), #2053(DIE), #10103(XLFDT), #10101(XQOR)
;
INIT(MSH) ;break out MSH segment separators and set other needed variables
;MSH = MSH segment of the HL-7 message
N X
S (SEP1,SEP2,SEP3,SEP4,SEP5)=""
S SEP1=$E(MSH,4),X=$P(MSH,SEP1,2)
S SEP2=$E(X,1),SEP3=$E(X,2),SEP4=$E(X,3),SEP5=$E(X,4)
Q
PID(GMRCPID) ;Get fields from PID segment and set into GMRC variables.
S DFN=$P(GMRCPID,SEP1,4),GMRCPNM=$P(GMRCPID,SEP1,6)
Q
NTE(MSG,GMRCNTE,GMRCNODE,CTRLCODE) ;set NTE segments of HL-7 message into variables and globals
;MSG = whole HL-7 array.
;GMRCNTE = Node in array where NTE message begins
;CTRLCODE = segment 1 of the ORC segment of HL-7 message
;GMRCNODE = IEN of entry int file ^GMR(123,
N GMRCACT ;not sure why this is newed here
S GMRCAD=$G(GMRCAD),GMRCORNP=$G(GMRCORNP),GMRCFF=$G(GMRCFF),GMRCPA=$G(GMRCPA),GMRCDEV=$G(GMRCDEV)
S GMRCACT=$S(CTRLCODE="CA":19,CTRLCODE="DC":6,CTRLCODE="NW":1,1:$O(^GMR(123.1,"D",CTRLCODE,0)))
S GMRCNTC(1)=$P(MSG(GMRCNTE),SEP1,4)
S LN=0,LN1=2 F S LN=$O(MSG(GMRCNTE,LN)) Q:LN="" S GMRCNTC(LN1)=MSG(GMRCNTE,LN),LN1=LN1+1
K LN,LN1
Q
PV1(GMRCPV1) ;Get fields from PV1 segment of HL-7 message and set into GMRC variables
;GMRCRB = patients room/bed GMRCWARD=patients ward
;GMRCSBR = service basis to be rendered (Inpatient or Outpatient)
N X
S X=$P(GMRCPV1,SEP1,3),GMRCSBR=$S(X]"":X,1:"")
S X=$P(GMRCPV1,SEP1,4),GMRCWARD=$S($P(X,SEP2,1)]"":$P(X,SEP2,1),1:""),VISIT=$S($P(GMRCPV1,SEP1,20)]"":$P(GMRCPV1,SEP1,20),1:"")
S GMRCRB=$S($P(X,SEP2,2)]"":$P(X,SEP2,2),1:"")
S:VISIT]"" GMRCVSIT=$$FMDATE^GMRCHL7(VISIT)
Q
;
REJECT(GMRCMSG,REAS) ;action can't be filed send reject message
N MSH,ORC,I ;GMRCMESS
S I=0 F S I=$O(GMRCMSG(I)) Q:'I D
. I $P(GMRCMSG(I),"|")="PID" S PID=GMRCMSG(I)
. I $P(GMRCMSG(I),"|")="ORC" D
.. N ORFN,GMRCFN,P17,CTRLCD
.. S ORFN=$P(GMRCMSG(I),"|",3),GMRCFN=$P(GMRCMSG(I),"|",4)
.. S CTRLCD=$P(GMRCMSG(I),"|",2)
.. S ORC="ORC|"_$S(CTRLCD="NW":"UA",1:"UD")_"|"_ORFN_"|"_GMRCFN
.. S P17=$S($D(REAS):REAS,1:"UNABLE TO FILE ACTION")
.. S $P(ORC,"|",17)="X^REJECTED^99ORN^^"_P17
S MSH=$$MSH^GMRCHL7
S $P(MSH,SEP1,9)="ORR"
S GMRCMESS(1)=MSH
S GMRCMESS(2)=PID
S GMRCMESS(3)=ORC
D MSG^XQOR("GMRC EVSEND OR",.GMRCMESS)
Q
;
RETURN(GMRCIEN,GMRCTRLC) ;return IEN of record in ^GMR(123,IEN, to OERR
;GMRCIEN = internal record number of record in ^GMR(123,
;GMRCTRLC=Control code from HL-7 Table 119
N MSH,PID,ORC,GMRCORCC
S SEP1="|",GMRCORCC=$S(GMRCTRLC="NW":"OK",GMRCTRLC="DC":"DR",1:"OK")
S MSH=$$MSH^GMRCHL7($G(X)) S $P(MSH,SEP1,9)="ORR"
S PID=$$PID^GMRCHL7(GMRCIEN)
D ORC^GMRCHL7(GMRCIEN,GMRCORCC,"") S ORC=$P(ORC,"|",1,4)
D BLD^GMRCHL7(MSH,PID,"",ORC,"","",,"",GMRCTRLC)
D MSG^XQOR("GMRC EVSEND OR",.GMRCMSG)
Q
FILE(GMRCO,DR) ;File data into ^GMR(123,IEN,40 using ^DIE
N DIE,DA,GMRCACTI
;GMRCO = IEN of record from file ^GMR(123,
;DR = DR string required by ^DIE
Q:'$G(GMRCO)
L +^GMR(123,+GMRCO,40):$S($G(DILOCKTM)>0:DILOCKTM,1:5) S:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^" ;wat/66 added lock timeout
S (DA,GMRCACTI)=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1),DA(1)=+GMRCO
S DIE="^GMR(123,"_GMRCO_",40,"
S $P(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
D ^DIE
I $D(GMRCNTC) D COMMENT^GMRCHL7B(.GMRCNTC)
I $D(GMRCCMT) D COMMENT^GMRCHL7B(.GMRCCMT)
D ; if record is an IFC build and send update
. I '$D(^GMR(123,GMRCO,12)) Q
. D TRIGR^GMRCIEVT(GMRCO,GMRCACTI)
L -^GMR(123,+GMRCO,40)
Q
EXIT ;Kill variables and exit
K HLQ,J,LN,ND,ND1,ND2,SEP1,SEP2,SEP3,SEP4,SEP5
K GMRCA,GMRCACT,GMRCAD,GMRCAP,GMRCAPP,GMRCATN,GMRCDA,GMRCDEV,GMRCFAC,GMRCFF,GMRCINTR,GMRCMTP,GMRCMSG,GMRCMSH,GMRCNOD,GMRCNTC,GMRCODT,GMRCOID,GMRCORFN,GMRCPA,GMRCPLCR,GMRCPLI,GMRCPNM,GMRCPR,GMRCPRI,GMRCFQ
K GMRCPRDG,GMRCSEND,GMRCSTDT,GMRCSTS,GMRCURGI,GMRCVAL,GMRCVTYP,GMRCWARD,GMRCPRV,GMRCTYPE,GMRCND,GMRCND1,VISIT
K GMRCRB,GMRCPRA,GMRCRFQ,MSH,OBXND,PID,GMRCORPV,GMRCOTXT,GMRCNATO,GMRCERDT,GMRCDSID
K GMRCOFN,GMRCS123,GMRCS38,GMRCCMT
K GMRCTRLC,GMRCSS,GMRCO,GMRCORNP
Q
AUDIT0 ;place activity audit tracking info into global ^GMR(123,IEN,40,
;GMRCACT=processing activity (from ^GMR(123.1,
;GMRCDA=date/time file entered GMRCAD=date/time activity took place
;GMRCORNP=name of provider GMRCFF=forwared from (if forwarded)
;GMRCPA=provider previously assigned
;GMRCDEV=device printed to GMRCCMT=comment array from OBX segment
N GMRCDA
S GMRCDA=$$NOW^XLFDT
L +^GMR(123,+GMRCO,40):$S($G(DILOCKTM)>0:DILOCKTM,1:5) S:'$D(^GMR(123,+GMRCO,40,0)) ^GMR(123,+GMRCO,40,0)="^123.02DA^^" ;wat/66 added lock timeout
S GMRCAD=$S($D(GMRCAD):GMRCAD,1:GMRCDA),GMRCORNP=$G(GMRCORNP),GMRCFF=$G(GMRCFF),GMRCPA=$G(GMRCPA),GMRCDEV=$G(GMRCDEV),GMRCPLCR=$G(GMRCPLCR)
;Use the Control code from CPRS in 123.1 to determine the action.
;If action undefined, then use "ADDED COMMENT", entry 20.
S GMRCACT=$O(^GMR(123.1,"D",GMRCTRLC,0))
S:'GMRCACT GMRCACT=20
S DR=".01////^S X=GMRCDA;1////^S X=GMRCACT;2////^S X=GMRCAD;3////^S X=GMRCORNP;4////^S X=GMRCPLCR;6////^S X=GMRCFF;7////^S X=GMRCPA;8////^S X=GMRCDEV"
D FILE(GMRCO,DR)
L -^GMR(123,+GMRCO,40)
Q
ALERT(GMRCDFN,GMRCSS,GMRCPR,GMRCFN,GMRCURG,GMRCORA) ;generate an alert when receiving a consult
;GMRCDFN=patient DFN from file 2
;GMRCSS=Service
;GMRCPR=procedure being ordered
;GMRCFN=File 123 IEN
;GMRCURG=urgency of request from protocol file
;GMRCADUZ=array of those who receive alerts
;GMRCORA=action to take on alert: 27 is for new alert
N GMRCORTX
S GMRCORTX="New consult "_$$ORTX^GMRCAU(+GMRCO)_$S(+GMRCURG:" ("_$P(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
S:'$D(GMRCORA) GMRCORA=27 S:GMRCORA="" GMRCORA=27
D MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCFN,GMRCORA,.GMRCADUZ,1)
K GMRCADUZ
Q
CHKTXT(GMRCTXT) ;Added by GMRC*3*168
N X1,X2
F X1=1:1:$L(GMRCTXT) D
. S X2=$E(GMRCTXT,X1,X1)
. I X2?.E1C.E S $E(GMRCTXT,X1,X1)=" "
Q GMRCTXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCHL7U 6194 printed Nov 22, 2024@16:56:04 Page 2
GMRCHL7U ;SLC/DCM,MA - Utilities assoc. with HL7 messages ; 12/1/20 4:51pm
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,21,22,29,66,145,168**;DEC 27, 1997;Build 3
+2 ; Patch #21 added more variables to in line tage EXIT.
+3 ;
+4 ; This routine invokes IA #872(FILE 101 ^ORD(100)), #2053(DIE), #10103(XLFDT), #10101(XQOR)
+5 ;
INIT(MSH) ;break out MSH segment separators and set other needed variables
+1 ;MSH = MSH segment of the HL-7 message
+2 NEW X
+3 SET (SEP1,SEP2,SEP3,SEP4,SEP5)=""
+4 SET SEP1=$EXTRACT(MSH,4)
SET X=$PIECE(MSH,SEP1,2)
+5 SET SEP2=$EXTRACT(X,1)
SET SEP3=$EXTRACT(X,2)
SET SEP4=$EXTRACT(X,3)
SET SEP5=$EXTRACT(X,4)
+6 QUIT
PID(GMRCPID) ;Get fields from PID segment and set into GMRC variables.
+1 SET DFN=$PIECE(GMRCPID,SEP1,4)
SET GMRCPNM=$PIECE(GMRCPID,SEP1,6)
+2 QUIT
NTE(MSG,GMRCNTE,GMRCNODE,CTRLCODE) ;set NTE segments of HL-7 message into variables and globals
+1 ;MSG = whole HL-7 array.
+2 ;GMRCNTE = Node in array where NTE message begins
+3 ;CTRLCODE = segment 1 of the ORC segment of HL-7 message
+4 ;GMRCNODE = IEN of entry int file ^GMR(123,
+5 ;not sure why this is newed here
NEW GMRCACT
+6 SET GMRCAD=$GET(GMRCAD)
SET GMRCORNP=$GET(GMRCORNP)
SET GMRCFF=$GET(GMRCFF)
SET GMRCPA=$GET(GMRCPA)
SET GMRCDEV=$GET(GMRCDEV)
+7 SET GMRCACT=$SELECT(CTRLCODE="CA":19,CTRLCODE="DC":6,CTRLCODE="NW":1,1:$ORDER(^GMR(123.1,"D",CTRLCODE,0)))
+8 SET GMRCNTC(1)=$PIECE(MSG(GMRCNTE),SEP1,4)
+9 SET LN=0
SET LN1=2
FOR
SET LN=$ORDER(MSG(GMRCNTE,LN))
if LN=""
QUIT
SET GMRCNTC(LN1)=MSG(GMRCNTE,LN)
SET LN1=LN1+1
+10 KILL LN,LN1
+11 QUIT
PV1(GMRCPV1) ;Get fields from PV1 segment of HL-7 message and set into GMRC variables
+1 ;GMRCRB = patients room/bed GMRCWARD=patients ward
+2 ;GMRCSBR = service basis to be rendered (Inpatient or Outpatient)
+3 NEW X
+4 SET X=$PIECE(GMRCPV1,SEP1,3)
SET GMRCSBR=$SELECT(X]"":X,1:"")
+5 SET X=$PIECE(GMRCPV1,SEP1,4)
SET GMRCWARD=$SELECT($PIECE(X,SEP2,1)]"":$PIECE(X,SEP2,1),1:"")
SET VISIT=$SELECT($PIECE(GMRCPV1,SEP1,20)]"":$PIECE(GMRCPV1,SEP1,20),1:"")
+6 SET GMRCRB=$SELECT($PIECE(X,SEP2,2)]"":$PIECE(X,SEP2,2),1:"")
+7 if VISIT]""
SET GMRCVSIT=$$FMDATE^GMRCHL7(VISIT)
+8 QUIT
+9 ;
REJECT(GMRCMSG,REAS) ;action can't be filed send reject message
+1 ;GMRCMESS
NEW MSH,ORC,I
+2 SET I=0
FOR
SET I=$ORDER(GMRCMSG(I))
if 'I
QUIT
Begin DoDot:1
+3 IF $PIECE(GMRCMSG(I),"|")="PID"
SET PID=GMRCMSG(I)
+4 IF $PIECE(GMRCMSG(I),"|")="ORC"
Begin DoDot:2
+5 NEW ORFN,GMRCFN,P17,CTRLCD
+6 SET ORFN=$PIECE(GMRCMSG(I),"|",3)
SET GMRCFN=$PIECE(GMRCMSG(I),"|",4)
+7 SET CTRLCD=$PIECE(GMRCMSG(I),"|",2)
+8 SET ORC="ORC|"_$SELECT(CTRLCD="NW":"UA",1:"UD")_"|"_ORFN_"|"_GMRCFN
+9 SET P17=$SELECT($DATA(REAS):REAS,1:"UNABLE TO FILE ACTION")
+10 SET $PIECE(ORC,"|",17)="X^REJECTED^99ORN^^"_P17
End DoDot:2
End DoDot:1
+11 SET MSH=$$MSH^GMRCHL7
+12 SET $PIECE(MSH,SEP1,9)="ORR"
+13 SET GMRCMESS(1)=MSH
+14 SET GMRCMESS(2)=PID
+15 SET GMRCMESS(3)=ORC
+16 DO MSG^XQOR("GMRC EVSEND OR",.GMRCMESS)
+17 QUIT
+18 ;
RETURN(GMRCIEN,GMRCTRLC) ;return IEN of record in ^GMR(123,IEN, to OERR
+1 ;GMRCIEN = internal record number of record in ^GMR(123,
+2 ;GMRCTRLC=Control code from HL-7 Table 119
+3 NEW MSH,PID,ORC,GMRCORCC
+4 SET SEP1="|"
SET GMRCORCC=$SELECT(GMRCTRLC="NW":"OK",GMRCTRLC="DC":"DR",1:"OK")
+5 SET MSH=$$MSH^GMRCHL7($GET(X))
SET $PIECE(MSH,SEP1,9)="ORR"
+6 SET PID=$$PID^GMRCHL7(GMRCIEN)
+7 DO ORC^GMRCHL7(GMRCIEN,GMRCORCC,"")
SET ORC=$PIECE(ORC,"|",1,4)
+8 DO BLD^GMRCHL7(MSH,PID,"",ORC,"","",,"",GMRCTRLC)
+9 DO MSG^XQOR("GMRC EVSEND OR",.GMRCMSG)
+10 QUIT
FILE(GMRCO,DR) ;File data into ^GMR(123,IEN,40 using ^DIE
+1 NEW DIE,DA,GMRCACTI
+2 ;GMRCO = IEN of record from file ^GMR(123,
+3 ;DR = DR string required by ^DIE
+4 if '$GET(GMRCO)
QUIT
+5 ;wat/66 added lock timeout
LOCK +^GMR(123,+GMRCO,40):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
if '$DATA(^GMR(123,+GMRCO,40,0))
SET ^(0)="^123.02DA^^"
+6 SET (DA,GMRCACTI)=$SELECT($PIECE(^GMR(123,+GMRCO,40,0),"^",3):$PIECE(^(0),"^",3)+1,1:1)
SET DA(1)=+GMRCO
+7 SET DIE="^GMR(123,"_GMRCO_",40,"
+8 SET $PIECE(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
+9 DO ^DIE
+10 IF $DATA(GMRCNTC)
DO COMMENT^GMRCHL7B(.GMRCNTC)
+11 IF $DATA(GMRCCMT)
DO COMMENT^GMRCHL7B(.GMRCCMT)
+12 ; if record is an IFC build and send update
Begin DoDot:1
+13 IF '$DATA(^GMR(123,GMRCO,12))
QUIT
+14 DO TRIGR^GMRCIEVT(GMRCO,GMRCACTI)
End DoDot:1
+15 LOCK -^GMR(123,+GMRCO,40)
+16 QUIT
EXIT ;Kill variables and exit
+1 KILL HLQ,J,LN,ND,ND1,ND2,SEP1,SEP2,SEP3,SEP4,SEP5
+2 KILL GMRCA,GMRCACT,GMRCAD,GMRCAP,GMRCAPP,GMRCATN,GMRCDA,GMRCDEV,GMRCFAC,GMRCFF,GMRCINTR,GMRCMTP,GMRCMSG,GMRCMSH,GMRCNOD,GMRCNTC,GMRCODT,GMRCOID,GMRCORFN,GMRCPA,GMRCPLCR,GMRCPLI,GMRCPNM,GMRCPR,GMRCPRI,GMRCFQ
+3 KILL GMRCPRDG,GMRCSEND,GMRCSTDT,GMRCSTS,GMRCURGI,GMRCVAL,GMRCVTYP,GMRCWARD,GMRCPRV,GMRCTYPE,GMRCND,GMRCND1,VISIT
+4 KILL GMRCRB,GMRCPRA,GMRCRFQ,MSH,OBXND,PID,GMRCORPV,GMRCOTXT,GMRCNATO,GMRCERDT,GMRCDSID
+5 KILL GMRCOFN,GMRCS123,GMRCS38,GMRCCMT
+6 KILL GMRCTRLC,GMRCSS,GMRCO,GMRCORNP
+7 QUIT
AUDIT0 ;place activity audit tracking info into global ^GMR(123,IEN,40,
+1 ;GMRCACT=processing activity (from ^GMR(123.1,
+2 ;GMRCDA=date/time file entered GMRCAD=date/time activity took place
+3 ;GMRCORNP=name of provider GMRCFF=forwared from (if forwarded)
+4 ;GMRCPA=provider previously assigned
+5 ;GMRCDEV=device printed to GMRCCMT=comment array from OBX segment
+6 NEW GMRCDA
+7 SET GMRCDA=$$NOW^XLFDT
+8 ;wat/66 added lock timeout
LOCK +^GMR(123,+GMRCO,40):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:5)
if '$DATA(^GMR(123,+GMRCO,40,0))
SET ^GMR(123,+GMRCO,40,0)="^123.02DA^^"
+9 SET GMRCAD=$SELECT($DATA(GMRCAD):GMRCAD,1:GMRCDA)
SET GMRCORNP=$GET(GMRCORNP)
SET GMRCFF=$GET(GMRCFF)
SET GMRCPA=$GET(GMRCPA)
SET GMRCDEV=$GET(GMRCDEV)
SET GMRCPLCR=$GET(GMRCPLCR)
+10 ;Use the Control code from CPRS in 123.1 to determine the action.
+11 ;If action undefined, then use "ADDED COMMENT", entry 20.
+12 SET GMRCACT=$ORDER(^GMR(123.1,"D",GMRCTRLC,0))
+13 if 'GMRCACT
SET GMRCACT=20
+14 SET DR=".01////^S X=GMRCDA;1////^S X=GMRCACT;2////^S X=GMRCAD;3////^S X=GMRCORNP;4////^S X=GMRCPLCR;6////^S X=GMRCFF;7////^S X=GMRCPA;8////^S X=GMRCDEV"
+15 DO FILE(GMRCO,DR)
+16 LOCK -^GMR(123,+GMRCO,40)
+17 QUIT
ALERT(GMRCDFN,GMRCSS,GMRCPR,GMRCFN,GMRCURG,GMRCORA) ;generate an alert when receiving a consult
+1 ;GMRCDFN=patient DFN from file 2
+2 ;GMRCSS=Service
+3 ;GMRCPR=procedure being ordered
+4 ;GMRCFN=File 123 IEN
+5 ;GMRCURG=urgency of request from protocol file
+6 ;GMRCADUZ=array of those who receive alerts
+7 ;GMRCORA=action to take on alert: 27 is for new alert
+8 NEW GMRCORTX
+9 SET GMRCORTX="New consult "_$$ORTX^GMRCAU(+GMRCO)_$SELECT(+GMRCURG:" ("_$PIECE(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
+10 if '$DATA(GMRCORA)
SET GMRCORA=27
if GMRCORA=""
SET GMRCORA=27
+11 DO MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCFN,GMRCORA,.GMRCADUZ,1)
+12 KILL GMRCADUZ
+13 QUIT
CHKTXT(GMRCTXT) ;Added by GMRC*3*168
+1 NEW X1,X2
+2 FOR X1=1:1:$LENGTH(GMRCTXT)
Begin DoDot:1
+3 SET X2=$EXTRACT(GMRCTXT,X1,X1)
+4 IF X2?.E1C.E
SET $EXTRACT(GMRCTXT,X1,X1)=" "
End DoDot:1
+5 QUIT GMRCTXT
