DVBCHLOR.m

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 ---DVBCHLOR   1298     printed  Apr 09, 2024@20:45:46                                                                                                                                                                                                    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