ALPBPPAT ;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCBU BACKUP REPORT FOR A SELECTED PATIENT ;01/01/03
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
; NOTE: this routine is designed for hard-copy output.
; Output is formatted for 132-column printing.
;
F D Q:$D(DIRUT)
.W !!,"Inpatient Pharmacy Orders for a selected patient"
.S DIR(0)="PAO^53.7:QEMZ"
.S DIR("A")="Select PATIENT NAME: "
.D ^DIR K DIR
.I $D(DIRUT) K X,Y Q
.S ALPBIEN=+Y
.S ALPBPTN=Y(0,0)
.; get all or just current orders?...
.S DIR(0)="SA^A:ALL;C:CURRENT"
.S DIR("A")="Report [A]LL or [C]URRENT orders? "
.S DIR("B")="CURRENT"
.S DIR("?")="[A]LL=all orders in the file, [C]URRENT=orders not yet expired."
.W ! D ^DIR K DIR
.I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
.S ALPBOTYP=Y
.;
.; print how many days MAR?...
.S DIR(0)="NA^3:7"
.S DIR("A")="Print how many days MAR? "
.S DIR("B")=$$DEFDAYS^ALPBUTL()
.S DIR("?")="The default is shown; you may select 3 or 7."
.W ! D ^DIR K DIR
.I $D(DIRUT) K ALPBOTYP,DIRUT,DTOUT,X,Y Q
.S ALPBDAYS=+Y
.;
.; BCMA Med Log info for how many ?...
.S DIR(0)="NA^1:99"
.S DIR("B")=$$DEFML^ALPBUTL3()
.S DIR("A")="Select how many BCMA Medication Log history: "
.S DIR("A",1)=" "
.S DIR("?",1)="Select a number of BCMA Medication log entries"
.S DIR("?",2)="for each of the patient's orders"
.S DIR("?")="They are listed by the most current entry first"
.D ^DIR K DIR
.I $D(DIRUT) K ALPBOTYP,ALPBWARD,DIRUT,DTOUT,X,Y Q
.S ALPBMLOG=Y
.;
.S %ZIS="Q"
.S %ZIS("B")=$$DEFPRT^ALPBUTL()
.I %ZIS("B")="" K %ZIS("B")
.W ! D ^%ZIS K %ZIS
.I POP D Q
..K ALPBIEN,ALPBPTN,POP
.;
.; output not queued...
.I '$D(IO("Q")) D
..U IO
..D DQ
..I IO'=IO(0) D ^%ZISC
.;
.; set up the Task...
.I $D(IO("Q")) D
..S ZTRTN="DQ^ALPBPPAT"
..S ZTIO=ION
..S ZTDESC="PSB INPT PHARM ORDERS FOR "_ALPBPTN
..S ZTSAVE("ALPBDAYS")=""
..S ZTSAVE("ALPBIEN")=""
..S ZTSAVE("ALPBMLOG")=""
..S ZTSAVE("ALPBOTYP")=""
..D ^%ZTLOAD
..D HOME^%ZIS
..W !!,$S(+$G(ZTSK):"Task "_ZTSK_" queued.",1:"ERROR: NOT QUEUED!")
..K IO("Q"),ZTSK
.;
.K ALPBDAYS,ALPBIEN,ALPBMLOG,ALPBOTYP,ALPBPTN,X,Y
K DIRUT,DTOUT,X,Y
Q
;
DQ ; output entry point...
K ^TMP($J)
;
; set report date...
S ALPBRDAT=$$NOW^XLFDT()
S ALPBPT(0)=$G(^ALPB(53.7,ALPBIEN,0))
M ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
S ALPBPG=1
D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
K ALPBHDR
;
; loop through orders and sort by order status...
S ALPBOIEN=0
F S ALPBOIEN=$O(^ALPB(53.7,ALPBIEN,2,ALPBOIEN)) Q:'ALPBOIEN D
.M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
.; if report type is "C"urrent and stop date is less than
.; report date, quit...
.I ALPBOTYP="C" D Q:'$D(ALPBDATA)
..I $G(ALPBDATA(1))="" K ALPBDATA Q
..I $P(ALPBDATA(1),U,2)<ALPBRDAT K ALPBDATA
.S ALPBORDN=$P(ALPBDATA(0),U)
.S ALPBOCT=$P($G(ALPBDATA(3)),U,1)
.S:$P($G(ALPBDATA(4)),U,3)["PRN" ALPBOCT=ALPBOCT_"P"
.S ALPBOST=$$STAT2^ALPBUTL1($P($G(ALPBDATA(1),"XX"),U,3))
.S ^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)=ALPBOIEN
.K ALPBDATA,ALPBOST,ALPBOCT
;
; loop through the sorted orders...
S ALPBOCT=""
F S ALPBOCT=$O(^TMP($J,ALPBOCT)) Q:ALPBOCT="" D
.S ALPBOST=""
.F S ALPBOST=$O(^TMP($J,ALPBOCT,ALPBOST)) Q:ALPBOST="" D
..S ALPBORDN=""
..F S ALPBORDN=$O(^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)) Q:ALPBORDN="" D
...S ALPBOIEN=^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)
...M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
...W !
...D F132^ALPBFRM1(.ALPBDATA,ALPBDAYS,ALPBMLOG,.ALPBFORM,ALPBIEN)
...; paginate?...
...I $Y+ALPBFORM(0)=IOSL!($Y+ALPBFORM(0)>IOSL) D
....W @IOF
....S ALPBPG=ALPBPG+1
....D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
....F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
....W !
....K ALPBHDR
...F I=1:1:ALPBFORM(0) W !,ALPBFORM(I)
...K ALPBDATA,ALPBFORM
..K ALPBORDN
.K ALPBOST
K ALPBOCT
;
; print footer at end of this patient's record...
D FOOT^ALPBFRMU
;
K ALPBDAYS,ALPBMLOG,ALPBOIEN,ALPBORDN,ALPBOST,ALPBOTYP,ALPBPG,ALPBPT,ALPBRDAT,^TMP($J)
I $D(ZTQUEUED) S ZTREQ="@"
;
; write form feed at end if output device is a printer...
I $E(IOST)="P" W @IOF
Q
ALPBPPAT ;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCBU BACKUP REPORT FOR A SELECTED PATIENT ;01/01/03
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
+3 ; NOTE: this routine is designed for hard-copy output.
+4 ; Output is formatted for 132-column printing.
+5 ;
+6 FOR
Begin DoDot:1
+7 WRITE !!,"Inpatient Pharmacy Orders for a selected patient"
+8 SET DIR(0)="PAO^53.7:QEMZ"
+9 SET DIR("A")="Select PATIENT NAME: "
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
KILL X,Y
QUIT
+12 SET ALPBIEN=+Y
+13 SET ALPBPTN=Y(0,0)
+14 ; get all or just current orders?...
+15 SET DIR(0)="SA^A:ALL;C:CURRENT"
+16 SET DIR("A")="Report [A]LL or [C]URRENT orders? "
+17 SET DIR("B")="CURRENT"
+18 SET DIR("?")="[A]LL=all orders in the file, [C]URRENT=orders not yet expired."
+19 WRITE !
DO ^DIR
KILL DIR
+20 IF $DATA(DIRUT)
KILL DIRUT,DTOUT,X,Y
QUIT
+21 SET ALPBOTYP=Y
+22 ;
+23 ; print how many days MAR?...
+24 SET DIR(0)="NA^3:7"
+25 SET DIR("A")="Print how many days MAR? "
+26 SET DIR("B")=$$DEFDAYS^ALPBUTL()
+27 SET DIR("?")="The default is shown; you may select 3 or 7."
+28 WRITE !
DO ^DIR
KILL DIR
+29 IF $DATA(DIRUT)
KILL ALPBOTYP,DIRUT,DTOUT,X,Y
QUIT
+30 SET ALPBDAYS=+Y
+31 ;
+32 ; BCMA Med Log info for how many ?...
+33 SET DIR(0)="NA^1:99"
+34 SET DIR("B")=$$DEFML^ALPBUTL3()
+35 SET DIR("A")="Select how many BCMA Medication Log history: "
+36 SET DIR("A",1)=" "
+37 SET DIR("?",1)="Select a number of BCMA Medication log entries"
+38 SET DIR("?",2)="for each of the patient's orders"
+39 SET DIR("?")="They are listed by the most current entry first"
+40 DO ^DIR
KILL DIR
+41 IF $DATA(DIRUT)
KILL ALPBOTYP,ALPBWARD,DIRUT,DTOUT,X,Y
QUIT
+42 SET ALPBMLOG=Y
+43 ;
+44 SET %ZIS="Q"
+45 SET %ZIS("B")=$$DEFPRT^ALPBUTL()
+46 IF %ZIS("B")=""
KILL %ZIS("B")
+47 WRITE !
DO ^%ZIS
KILL %ZIS
+48 IF POP
Begin DoDot:2
+49 KILL ALPBIEN,ALPBPTN,POP
End DoDot:2
QUIT
+50 ;
+51 ; output not queued...
+52 IF '$DATA(IO("Q"))
Begin DoDot:2
+53 USE IO
+54 DO DQ
+55 IF IO'=IO(0)
DO ^%ZISC
End DoDot:2
+56 ;
+57 ; set up the Task...
+58 IF $DATA(IO("Q"))
Begin DoDot:2
+59 SET ZTRTN="DQ^ALPBPPAT"
+60 SET ZTIO=ION
+61 SET ZTDESC="PSB INPT PHARM ORDERS FOR "_ALPBPTN
+62 SET ZTSAVE("ALPBDAYS")=""
+63 SET ZTSAVE("ALPBIEN")=""
+64 SET ZTSAVE("ALPBMLOG")=""
+65 SET ZTSAVE("ALPBOTYP")=""
+66 DO ^%ZTLOAD
+67 DO HOME^%ZIS
+68 WRITE !!,$SELECT(+$GET(ZTSK):"Task "_ZTSK_" queued.",1:"ERROR: NOT QUEUED!")
+69 KILL IO("Q"),ZTSK
End DoDot:2
+70 ;
+71 KILL ALPBDAYS,ALPBIEN,ALPBMLOG,ALPBOTYP,ALPBPTN,X,Y
End DoDot:1
IF $DATA(DIRUT)
QUIT
+72 KILL DIRUT,DTOUT,X,Y
+73 QUIT
+74 ;
DQ ; output entry point...
+1 KILL ^TMP($JOB)
+2 ;
+3 ; set report date...
+4 SET ALPBRDAT=$$NOW^XLFDT()
+5 SET ALPBPT(0)=$GET(^ALPB(53.7,ALPBIEN,0))
+6 MERGE ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
+7 SET ALPBPG=1
+8 DO HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
+9 FOR I=1:1:ALPBHDR(0)
WRITE !,ALPBHDR(I)
+10 KILL ALPBHDR
+11 ;
+12 ; loop through orders and sort by order status...
+13 SET ALPBOIEN=0
+14 FOR
SET ALPBOIEN=$ORDER(^ALPB(53.7,ALPBIEN,2,ALPBOIEN))
IF 'ALPBOIEN
QUIT
Begin DoDot:1
+15 MERGE ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
+16 ; if report type is "C"urrent and stop date is less than
+17 ; report date, quit...
+18 IF ALPBOTYP="C"
Begin DoDot:2
+19 IF $GET(ALPBDATA(1))=""
KILL ALPBDATA
QUIT
+20 IF $PIECE(ALPBDATA(1),U,2)<ALPBRDAT
KILL ALPBDATA
End DoDot:2
IF '$DATA(ALPBDATA)
QUIT
+21 SET ALPBORDN=$PIECE(ALPBDATA(0),U)
+22 SET ALPBOCT=$PIECE($GET(ALPBDATA(3)),U,1)
+23 IF $PIECE($GET(ALPBDATA(4)),U,3)["PRN"
SET ALPBOCT=ALPBOCT_"P"
+24 SET ALPBOST=$$STAT2^ALPBUTL1($PIECE($GET(ALPBDATA(1),"XX"),U,3))
+25 SET ^TMP($JOB,ALPBOCT,ALPBOST,ALPBORDN)=ALPBOIEN
+26 KILL ALPBDATA,ALPBOST,ALPBOCT
End DoDot:1
+27 ;
+28 ; loop through the sorted orders...
+29 SET ALPBOCT=""
+30 FOR
SET ALPBOCT=$ORDER(^TMP($JOB,ALPBOCT))
IF ALPBOCT=""
QUIT
Begin DoDot:1
+31 SET ALPBOST=""
+32 FOR
SET ALPBOST=$ORDER(^TMP($JOB,ALPBOCT,ALPBOST))
IF ALPBOST=""
QUIT
Begin DoDot:2
+33 SET ALPBORDN=""
+34 FOR
SET ALPBORDN=$ORDER(^TMP($JOB,ALPBOCT,ALPBOST,ALPBORDN))
IF ALPBORDN=""
QUIT
Begin DoDot:3
+35 SET ALPBOIEN=^TMP($JOB,ALPBOCT,ALPBOST,ALPBORDN)
+36 MERGE ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
+37 WRITE !
+38 DO F132^ALPBFRM1(.ALPBDATA,ALPBDAYS,ALPBMLOG,.ALPBFORM,ALPBIEN)
+39 ; paginate?...
+40 IF $Y+ALPBFORM(0)=IOSL!($Y+ALPBFORM(0)>IOSL)
Begin DoDot:4
+41 WRITE @IOF
+42 SET ALPBPG=ALPBPG+1
+43 DO HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
+44 FOR I=1:1:ALPBHDR(0)
WRITE !,ALPBHDR(I)
+45 WRITE !
+46 KILL ALPBHDR
End DoDot:4
+47 FOR I=1:1:ALPBFORM(0)
WRITE !,ALPBFORM(I)
+48 KILL ALPBDATA,ALPBFORM
End DoDot:3
+49 KILL ALPBORDN
End DoDot:2
+50 KILL ALPBOST
End DoDot:1
+51 KILL ALPBOCT
+52 ;
+53 ; print footer at end of this patient's record...
+54 DO FOOT^ALPBFRMU
+55 ;
+56 KILL ALPBDAYS,ALPBMLOG,ALPBOIEN,ALPBORDN,ALPBOST,ALPBOTYP,ALPBPG,ALPBPT,ALPBRDAT,^TMP($JOB)
+57 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+58 ;
+59 ; write form feed at end if output device is a printer...
+60 IF $EXTRACT(IOST)="P"
WRITE @IOF
+61 QUIT
