| 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
|
|---|
