DVBCHLOR ;ALB/JLU-Routine to build an order message ;1/28/93
;;2.7;AMIE;;Apr 10, 1995
;
BEG(DVBCPDFN,DVBCRDFN,DVBCEXAM,DVBCOC,HLDAP) ;
;when entering this routine the following variables must be set.
;DVBCPDFN - Patient DFN
;DVBCRDFN - Request DFN
;DVBCEXAM - Exam DFN
;DVBCOC - Order Control "NEW" for a new order or "CANCEL" to cancel
; an order.
;HLDAP - name or IFN of entry in file #771 (the DHCP application)
;
N DVBCERR
S DVBCERR=1
D INITIAL
I '$D(HLERR) D
.D PID^DVBCHLUT
.D ORC^DVBCHLUT
.D OBR^DVBCHLUT
.Q
D FILE
D EXIT
Q DVBCERR
;
INITIAL ;sets up necessary variables
;will need HLDAP equal to name or internal entry number in file #771
D INIT^HLTRANS Q:$D(HLERR)
S DFN=DVBCPDFN
D DEM^VADPT
I VAERR!VADM(1)']"" S HLERR="Invalid Patient name or DFN"
S DVBCSEG=1,DVBCPLCR=1
S DVBCRQDT=$P(^DVB(396.3,DVBCRDFN,0),U,2)
S DVBCEXTY=$P(^DVB(396.4,DVBCEXAM,0),U,3)
S DVBCEXTY=$P(^DVB(396.6,DVBCEXTY,0),U,1)
S DVBCOC=$S(DVBCOC="NEW":"NW",DVBCOC="CANCEL":"CA",1:"")
Q
;
FILE ;builds and send the HL7 message
I '$D(HLERR) S HLMTN="ORM" D EN^HLTRANS
I $D(HLERR) S DVBCERR=HLERR
Q
;
EXIT ;
D KILL^HLTRANS
K HLDA,HLDT,HLDT1,DFN,DVBC1,DVBCOC,DVBCEXTY,DVBCPDFN,DVBCPLCR,DVBCRQDT,DVBCSEG,VA,VADM,VAERR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCHLOR 1298 printed Sep 23, 2025@19:20:20 Page 2
DVBCHLOR ;ALB/JLU-Routine to build an order message ;1/28/93
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
BEG(DVBCPDFN,DVBCRDFN,DVBCEXAM,DVBCOC,HLDAP) ;
+1 ;when entering this routine the following variables must be set.
+2 ;DVBCPDFN - Patient DFN
+3 ;DVBCRDFN - Request DFN
+4 ;DVBCEXAM - Exam DFN
+5 ;DVBCOC - Order Control "NEW" for a new order or "CANCEL" to cancel
+6 ; an order.
+7 ;HLDAP - name or IFN of entry in file #771 (the DHCP application)
+8 ;
+9 NEW DVBCERR
+10 SET DVBCERR=1
+11 DO INITIAL
+12 IF '$DATA(HLERR)
Begin DoDot:1
+13 DO PID^DVBCHLUT
+14 DO ORC^DVBCHLUT
+15 DO OBR^DVBCHLUT
+16 QUIT
End DoDot:1
+17 DO FILE
+18 DO EXIT
+19 QUIT DVBCERR
+20 ;
INITIAL ;sets up necessary variables
+1 ;will need HLDAP equal to name or internal entry number in file #771
+2 DO INIT^HLTRANS
if $DATA(HLERR)
QUIT
+3 SET DFN=DVBCPDFN
+4 DO DEM^VADPT
+5 IF VAERR!VADM(1)']""
SET HLERR="Invalid Patient name or DFN"
+6 SET DVBCSEG=1
SET DVBCPLCR=1
+7 SET DVBCRQDT=$PIECE(^DVB(396.3,DVBCRDFN,0),U,2)
+8 SET DVBCEXTY=$PIECE(^DVB(396.4,DVBCEXAM,0),U,3)
+9 SET DVBCEXTY=$PIECE(^DVB(396.6,DVBCEXTY,0),U,1)
+10 SET DVBCOC=$SELECT(DVBCOC="NEW":"NW",DVBCOC="CANCEL":"CA",1:"")
+11 QUIT
+12 ;
FILE ;builds and send the HL7 message
+1 IF '$DATA(HLERR)
SET HLMTN="ORM"
DO EN^HLTRANS
+2 IF $DATA(HLERR)
SET DVBCERR=HLERR
+3 QUIT
+4 ;
EXIT ;
+1 DO KILL^HLTRANS
+2 KILL HLDA,HLDT,HLDT1,DFN,DVBC1,DVBCOC,DVBCEXTY,DVBCPDFN,DVBCPLCR,DVBCRQDT,DVBCSEG,VA,VADM,VAERR
+3 QUIT
