- 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 Jan 18, 2025@02:46:59 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