| [613] | 1 | DVBCHLOR ;ALB/JLU-Routine to build an order message ;1/28/93
 | 
|---|
 | 2 |  ;;2.7;AMIE;;Apr 10, 1995
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 | BEG(DVBCPDFN,DVBCRDFN,DVBCEXAM,DVBCOC,HLDAP) ;
 | 
|---|
 | 5 |  ;when entering this routine the following variables must be set.
 | 
|---|
 | 6 |  ;DVBCPDFN - Patient DFN
 | 
|---|
 | 7 |  ;DVBCRDFN - Request DFN
 | 
|---|
 | 8 |  ;DVBCEXAM - Exam DFN
 | 
|---|
 | 9 |  ;DVBCOC   - Order Control "NEW" for a new order or "CANCEL" to cancel
 | 
|---|
 | 10 |  ;           an order.
 | 
|---|
 | 11 |  ;HLDAP    - name or IFN of entry in file #771 (the DHCP application)
 | 
|---|
 | 12 |  ;
 | 
|---|
 | 13 |  N DVBCERR
 | 
|---|
 | 14 |  S DVBCERR=1
 | 
|---|
 | 15 |  D INITIAL
 | 
|---|
 | 16 |  I '$D(HLERR) D
 | 
|---|
 | 17 |  .D PID^DVBCHLUT
 | 
|---|
 | 18 |  .D ORC^DVBCHLUT
 | 
|---|
 | 19 |  .D OBR^DVBCHLUT
 | 
|---|
 | 20 |  .Q
 | 
|---|
 | 21 |  D FILE
 | 
|---|
 | 22 |  D EXIT
 | 
|---|
 | 23 |  Q DVBCERR
 | 
|---|
 | 24 |  ;
 | 
|---|
 | 25 | INITIAL ;sets up necessary variables
 | 
|---|
 | 26 |  ;will need HLDAP equal to name or internal entry number in file #771
 | 
|---|
 | 27 |  D INIT^HLTRANS Q:$D(HLERR)
 | 
|---|
 | 28 |  S DFN=DVBCPDFN
 | 
|---|
 | 29 |  D DEM^VADPT
 | 
|---|
 | 30 |  I VAERR!VADM(1)']"" S HLERR="Invalid Patient name or DFN"
 | 
|---|
 | 31 |  S DVBCSEG=1,DVBCPLCR=1
 | 
|---|
 | 32 |  S DVBCRQDT=$P(^DVB(396.3,DVBCRDFN,0),U,2)
 | 
|---|
 | 33 |  S DVBCEXTY=$P(^DVB(396.4,DVBCEXAM,0),U,3)
 | 
|---|
 | 34 |  S DVBCEXTY=$P(^DVB(396.6,DVBCEXTY,0),U,1)
 | 
|---|
 | 35 |  S DVBCOC=$S(DVBCOC="NEW":"NW",DVBCOC="CANCEL":"CA",1:"")
 | 
|---|
 | 36 |  Q
 | 
|---|
 | 37 |  ;
 | 
|---|
 | 38 | FILE ;builds and send the HL7 message
 | 
|---|
 | 39 |  I '$D(HLERR) S HLMTN="ORM" D EN^HLTRANS
 | 
|---|
 | 40 |  I $D(HLERR) S DVBCERR=HLERR
 | 
|---|
 | 41 |  Q
 | 
|---|
 | 42 |  ;
 | 
|---|
 | 43 | EXIT ;
 | 
|---|
 | 44 |  D KILL^HLTRANS
 | 
|---|
 | 45 |  K HLDA,HLDT,HLDT1,DFN,DVBC1,DVBCOC,DVBCEXTY,DVBCPDFN,DVBCPLCR,DVBCRQDT,DVBCSEG,VA,VADM,VAERR
 | 
|---|
 | 46 |  Q
 | 
|---|