GMRCHL72 ;SLC/DCM - HL-7 formats OBX and NTE segments ;06/27/12 07:58
;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,29,73**;DEC 27, 1997;Build 22
;
; This routine invokes IA #872
;
Q
OBX(GMRCIFN) ;Build the OBX segment of the HL-7 message
;GMRCIFN=GMRCIEN - the internal file # of the record from file 123
N OBXSEGNO,GMRCND,GMRCND1,GMRCSYS
S OBXSEGNO=0
I ORCTRL'="RT",$D(^GMR(123,GMRCIFN,20,0)) S GMRCND=0,GMRCND1=0 D
. S OBXSEGNO=OBXSEGNO+1
. S GMRCND=$O(^GMR(123,GMRCIFN,20,GMRCND))
. S OBX(OBXSEGNO)="OBX|"_OBXSEGNO
. S OBX(OBXSEGNO)=OBX(OBXSEGNO)_"|TX|2000.02^REASON FOR REQUEST^AS4||"
. S OBX(OBXSEGNO)=OBX(OBXSEGNO)_^GMR(123,GMRCIFN,20,GMRCND,0)
. S GMRCND1=GMRCND1+1
. F S GMRCND=$O(^GMR(123,GMRCIFN,20,GMRCND)) Q:GMRCND="" D
.. S OBX(OBXSEGNO,GMRCND1)=^GMR(123,GMRCIFN,20,GMRCND,0)
.. S GMRCND1=GMRCND1+1
.Q
I $D(^GMR(123,GMRCIFN,30)) S OBXSEGNO=OBXSEGNO+1 D
. S OBX(OBXSEGNO)="OBX|"_OBXSEGNO
. N OBXSEG
. I '$D(^GMR(123,GMRCIFN,30.1)) D
.. S OBXSEG="|TX|^PROVISIONAL DIAGNOSIS^||"_$G(^GMR(123,GMRCIFN,30))
. I $D(^GMR(123,GMRCIFN,30.1)) D
.. S GMRCSYS=$P(^GMR(123,GMRCIFN,30.1),U,3) S GMRCSYS=$S(GMRCSYS="ICD":"I9C",GMRCSYS="10D":"I10",1:"") ;WAT/73
.. S OBXSEG="|CE|^PROVISIONAL DIAGNOSIS^||"_$P(^GMR(123,GMRCIFN,30.1),U)_U
.. S OBXSEG=OBXSEG_$P(^GMR(123,GMRCIFN,30),(" ("_^(30.1)))_U_GMRCSYS ;WAT/73
. S OBX(OBXSEGNO)=OBX(OBXSEGNO)_OBXSEG
I ORCTRL="RE",$L($P(^GMR(123,GMRCIFN,0),U,19)) D
. S OBXSEGNO=OBXSEGNO+1
. S OBX(OBXSEGNO)="OBX|"_OBXSEGNO
. N OBXSEG
. S OBXSEG="|TX|^SIG FINDINGS^|1|"_$P(^GMR(123,GMRCIFN,0),U,19)
. S OBX(OBXSEGNO)=OBX(OBXSEGNO)_OBXSEG
Q
;
NTE(GMRCFN,GMRCND,GMRCTRL) ;Build the NTE segment of the HL7 message
;GMRCND=GMRCOM, an array. GMRCND = flag that a comment exists.
;GMRCND(0)= DA = the internal entry in node 40: ^GMR(123,IEN,40,DA
;GMRCTRL=HL7 control code from table 119
Q:'$D(GMRCND(0)) S ND=GMRCND(0)
S ND2=1,NTE(ND2)="NTE|16|L|"
I $S($P(^GMR(123,GMRCFN,40,ND,0),"^",2)=6:1,$P(^(0),"^",2)=20:1,$P(^(0),"^",2)=7:1,$P(^(0),"^",2)=5:1,GMRCTRL="XX":1,1:0) D
.S ND1=0,ND1=$O(^GMR(123,GMRCFN,40,ND,1,ND1)) Q:ND1="" S NTE(ND2)=NTE(ND2)_^GMR(123,GMRCFN,40,ND,1,ND1,0),ND2=ND2+1
.F S ND1=$O(^GMR(123,GMRCFN,40,ND,1,ND1)) Q:ND1="" S NTE(ND2)=^GMR(123,GMRCFN,40,ND,1,ND1,0),ND2=ND2+1
.Q
;I $P(NTE(1),"|",4)="",$S(GMRCTRL="OD":1,GMRCTRL="OC":1,1:0) S $P(NTE(1),"|",4)=$P(^GMR(123.1,$P(^GMR(123,GMRCFN,40,ND,0),"^",2),0),"^",1)_$S($P(^(0),"^",2)]"":" BY SERVICE",1:"")
I GMRCTRL="OD"!(GMRCTRL="OC") D
. N ACTION S ACTION=$P(^GMR(123,GMRCFN,40,ND,0),"^",2) Q:ACTION=""
. S ACTION=$$GET1^DIQ(123.1,ACTION,.01)
. S $P(NTE(1),"|",4)=ACTION_" BY SERVICE"
I $P(NTE(1),"|",4)="",GMRCTRL="XX" S $P(NTE(1),"|",4)=$P(^GMR(123.1,$P(^GMR(123,GMRCFN,40,ND,0),"^",2),0),"^",1)_" "_$S($P(^GMR(123,GMRCFN,40,ND,0),"^",6)]"":$P(^GMR(123.5,$P(^GMR(123,GMRCFN,40,ND,0),"^",6),0),"^",1),1:GMRCSSNM)
K N,ND1,ND2
Q
OBR(GMRCIEN,RESBY,GMRCACDT) ;Build the OBR segment of the HL-7 message
;GMRCIEN=IEN of the consult from file 123
;NOTIFY=Person who is notified when consult is ordered/completed
;RESBY=Person entering/interpreting result & signing report- GMRCPROV
K OBR
N OI,PROCID,PROCNM,STS,RESTATUS,SERVID,ORCDT,CONLOC,CONSVC,HL7DT
;I +$P(^GMR(123,GMRCIEN,0),"^",5)'>0,$S($D(GMRCSSNM):1,+GMRCGRP("ROOT"):1,1:0) S $P(^(0),"^",5)=$S(+GMRCGRP("ROOT"):GMRCGRP("ROOT"),1:$O(^GMR(123.5,"B",GMRCSSNM,0)))
S STS=$P(^GMR(123,GMRCIEN,0),"^",12),RESTATUS=$S(STS=1:"X",STS=2:"F",STS=5:"O",STS=6:"I",STS=8:"S",STS=9:"R",1:"X")
S SERVID=$P(^GMR(123,GMRCIEN,0),"^",5),ORCDT=$P(^(0),"^",7),CONLOC=$P(^(0),"^",10) I CONLOC]"" S CONLOC=$S($P(^ORD(101,CONLOC,0),"^",1)["BEDSIDE":"B",$P(^(0),"^",1)["EMERGENCY":"E",1:"OC")
S NOTIFY=$P(^GMR(123,GMRCIEN,0),"^",11),CONSVC=$S(+SERVID]"":$P($G(^GMR(123.5,+SERVID,0)),"^",1),1:"")
I +$P(^GMR(123,+GMRCIEN,0),U,8) D
. S PROCID=+$P(^GMR(123,+GMRCIEN,0),U,8)
. S PROCNM=$$GET1^DIQ(123.3,PROCID,.01)
. S OI=PROCID_U_PROCNM_"^99PRC"
I '$D(OI) S OI=SERVID_U_CONSVC_"^99CON"
S HL7DT=$$HL7DT^GMRCHL7($S($G(GMRCACDT):GMRCACDT,1:$$NOW^XLFDT))
S OBR="OBR||||^^^"_OI_"||||||||||||||"_CONLOC_"|"_NOTIFY_"|||"_HL7DT_"|||"_RESTATUS_$S(RESBY]"":"|||||||"_RESBY,1:"")
K STS,RESTATUS,SERVID,ORCDT,CONLOC,CONSVC,HL7DT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCHL72 4291 printed Apr 09, 2024@20:50:06 Page 2
GMRCHL72 ;SLC/DCM - HL-7 formats OBX and NTE segments ;06/27/12 07:58
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,29,73**;DEC 27, 1997;Build 22
+2 ;
+3 ; This routine invokes IA #872
+4 ;
+5 QUIT
OBX(GMRCIFN) ;Build the OBX segment of the HL-7 message
+1 ;GMRCIFN=GMRCIEN - the internal file # of the record from file 123
+2 NEW OBXSEGNO,GMRCND,GMRCND1,GMRCSYS
+3 SET OBXSEGNO=0
+4 IF ORCTRL'="RT"
IF $DATA(^GMR(123,GMRCIFN,20,0))
SET GMRCND=0
SET GMRCND1=0
Begin DoDot:1
+5 SET OBXSEGNO=OBXSEGNO+1
+6 SET GMRCND=$ORDER(^GMR(123,GMRCIFN,20,GMRCND))
+7 SET OBX(OBXSEGNO)="OBX|"_OBXSEGNO
+8 SET OBX(OBXSEGNO)=OBX(OBXSEGNO)_"|TX|2000.02^REASON FOR REQUEST^AS4||"
+9 SET OBX(OBXSEGNO)=OBX(OBXSEGNO)_^GMR(123,GMRCIFN,20,GMRCND,0)
+10 SET GMRCND1=GMRCND1+1
+11 FOR
SET GMRCND=$ORDER(^GMR(123,GMRCIFN,20,GMRCND))
if GMRCND=""
QUIT
Begin DoDot:2
+12 SET OBX(OBXSEGNO,GMRCND1)=^GMR(123,GMRCIFN,20,GMRCND,0)
+13 SET GMRCND1=GMRCND1+1
End DoDot:2
+14 QUIT
End DoDot:1
+15 IF $DATA(^GMR(123,GMRCIFN,30))
SET OBXSEGNO=OBXSEGNO+1
Begin DoDot:1
+16 SET OBX(OBXSEGNO)="OBX|"_OBXSEGNO
+17 NEW OBXSEG
+18 IF '$DATA(^GMR(123,GMRCIFN,30.1))
Begin DoDot:2
+19 SET OBXSEG="|TX|^PROVISIONAL DIAGNOSIS^||"_$GET(^GMR(123,GMRCIFN,30))
End DoDot:2
+20 IF $DATA(^GMR(123,GMRCIFN,30.1))
Begin DoDot:2
+21 ;WAT/73
SET GMRCSYS=$PIECE(^GMR(123,GMRCIFN,30.1),U,3)
SET GMRCSYS=$SELECT(GMRCSYS="ICD":"I9C",GMRCSYS="10D":"I10",1:"")
+22 SET OBXSEG="|CE|^PROVISIONAL DIAGNOSIS^||"_$PIECE(^GMR(123,GMRCIFN,30.1),U)_U
+23 ;WAT/73
SET OBXSEG=OBXSEG_$PIECE(^GMR(123,GMRCIFN,30),(" ("_^(30.1)))_U_GMRCSYS
End DoDot:2
+24 SET OBX(OBXSEGNO)=OBX(OBXSEGNO)_OBXSEG
End DoDot:1
+25 IF ORCTRL="RE"
IF $LENGTH($PIECE(^GMR(123,GMRCIFN,0),U,19))
Begin DoDot:1
+26 SET OBXSEGNO=OBXSEGNO+1
+27 SET OBX(OBXSEGNO)="OBX|"_OBXSEGNO
+28 NEW OBXSEG
+29 SET OBXSEG="|TX|^SIG FINDINGS^|1|"_$PIECE(^GMR(123,GMRCIFN,0),U,19)
+30 SET OBX(OBXSEGNO)=OBX(OBXSEGNO)_OBXSEG
End DoDot:1
+31 QUIT
+32 ;
NTE(GMRCFN,GMRCND,GMRCTRL) ;Build the NTE segment of the HL7 message
+1 ;GMRCND=GMRCOM, an array. GMRCND = flag that a comment exists.
+2 ;GMRCND(0)= DA = the internal entry in node 40: ^GMR(123,IEN,40,DA
+3 ;GMRCTRL=HL7 control code from table 119
+4 if '$DATA(GMRCND(0))
QUIT
SET ND=GMRCND(0)
+5 SET ND2=1
SET NTE(ND2)="NTE|16|L|"
+6 IF $SELECT($PIECE(^GMR(123,GMRCFN,40,ND,0),"^",2)=6:1,$PIECE(^(0),"^",2)=20:1,$PIECE(^(0),"^",2)=7:1,$PIECE(^(0),"^",2)=5:1,GMRCTRL="XX":1,1:0)
Begin DoDot:1
+7 SET ND1=0
SET ND1=$ORDER(^GMR(123,GMRCFN,40,ND,1,ND1))
if ND1=""
QUIT
SET NTE(ND2)=NTE(ND2)_^GMR(123,GMRCFN,40,ND,1,ND1,0)
SET ND2=ND2+1
+8 FOR
SET ND1=$ORDER(^GMR(123,GMRCFN,40,ND,1,ND1))
if ND1=""
QUIT
SET NTE(ND2)=^GMR(123,GMRCFN,40,ND,1,ND1,0)
SET ND2=ND2+1
+9 QUIT
End DoDot:1
+10 ;I $P(NTE(1),"|",4)="",$S(GMRCTRL="OD":1,GMRCTRL="OC":1,1:0) S $P(NTE(1),"|",4)=$P(^GMR(123.1,$P(^GMR(123,GMRCFN,40,ND,0),"^",2),0),"^",1)_$S($P(^(0),"^",2)]"":" BY SERVICE",1:"")
+11 IF GMRCTRL="OD"!(GMRCTRL="OC")
Begin DoDot:1
+12 NEW ACTION
SET ACTION=$PIECE(^GMR(123,GMRCFN,40,ND,0),"^",2)
if ACTION=""
QUIT
+13 SET ACTION=$$GET1^DIQ(123.1,ACTION,.01)
+14 SET $PIECE(NTE(1),"|",4)=ACTION_" BY SERVICE"
End DoDot:1
+15 IF $PIECE(NTE(1),"|",4)=""
IF GMRCTRL="XX"
SET $PIECE(NTE(1),"|",4)=$PIECE(^GMR(123.1,$PIECE(^GMR(123,GMRCFN,40,ND,0),"^",2),0),"^",1)_" "_$SELECT($PIECE(^GMR(123,GMRCFN,40,ND,0),"^",6)]"":$PIECE(^GMR(123.5,$PIECE(^GMR(123,GMRCFN,40,ND,0),"^",6),0),"^",1),1:GMRCSSNM)
+16 KILL N,ND1,ND2
+17 QUIT
OBR(GMRCIEN,RESBY,GMRCACDT) ;Build the OBR segment of the HL-7 message
+1 ;GMRCIEN=IEN of the consult from file 123
+2 ;NOTIFY=Person who is notified when consult is ordered/completed
+3 ;RESBY=Person entering/interpreting result & signing report- GMRCPROV
+4 KILL OBR
+5 NEW OI,PROCID,PROCNM,STS,RESTATUS,SERVID,ORCDT,CONLOC,CONSVC,HL7DT
+6 ;I +$P(^GMR(123,GMRCIEN,0),"^",5)'>0,$S($D(GMRCSSNM):1,+GMRCGRP("ROOT"):1,1:0) S $P(^(0),"^",5)=$S(+GMRCGRP("ROOT"):GMRCGRP("ROOT"),1:$O(^GMR(123.5,"B",GMRCSSNM,0)))
+7 SET STS=$PIECE(^GMR(123,GMRCIEN,0),"^",12)
SET RESTATUS=$SELECT(STS=1:"X",STS=2:"F",STS=5:"O",STS=6:"I",STS=8:"S",STS=9:"R",1:"X")
+8 SET SERVID=$PIECE(^GMR(123,GMRCIEN,0),"^",5)
SET ORCDT=$PIECE(^(0),"^",7)
SET CONLOC=$PIECE(^(0),"^",10)
IF CONLOC]""
SET CONLOC=$SELECT($PIECE(^ORD(101,CONLOC,0),"^",1)["BEDSIDE":"B",$PIECE(^(0),"^",1)["EMERGENCY":"E",1:"OC")
+9 SET NOTIFY=$PIECE(^GMR(123,GMRCIEN,0),"^",11)
SET CONSVC=$SELECT(+SERVID]"":$PIECE($GET(^GMR(123.5,+SERVID,0)),"^",1),1:"")
+10 IF +$PIECE(^GMR(123,+GMRCIEN,0),U,8)
Begin DoDot:1
+11 SET PROCID=+$PIECE(^GMR(123,+GMRCIEN,0),U,8)
+12 SET PROCNM=$$GET1^DIQ(123.3,PROCID,.01)
+13 SET OI=PROCID_U_PROCNM_"^99PRC"
End DoDot:1
+14 IF '$DATA(OI)
SET OI=SERVID_U_CONSVC_"^99CON"
+15 SET HL7DT=$$HL7DT^GMRCHL7($SELECT($GET(GMRCACDT):GMRCACDT,1:$$NOW^XLFDT))
+16 SET OBR="OBR||||^^^"_OI_"||||||||||||||"_CONLOC_"|"_NOTIFY_"|||"_HL7DT_"|||"_RESTATUS_$SELECT(RESBY]"":"|||||||"_RESBY,1:"")
+17 KILL STS,RESTATUS,SERVID,ORCDT,CONLOC,CONSVC,HL7DT
+18 QUIT
