| 1 | ALPBPPAT ;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCBU BACKUP REPORT FOR A SELECTED PATIENT ;01/01/03
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
|
|---|
| 3 | ;
|
|---|
| 4 | ; NOTE: this routine is designed for hard-copy output.
|
|---|
| 5 | ; Output is formatted for 132-column printing.
|
|---|
| 6 | ;
|
|---|
| 7 | F D Q:$D(DIRUT)
|
|---|
| 8 | .W !!,"Inpatient Pharmacy Orders for a selected patient"
|
|---|
| 9 | .S DIR(0)="PAO^53.7:QEMZ"
|
|---|
| 10 | .S DIR("A")="Select PATIENT NAME: "
|
|---|
| 11 | .D ^DIR K DIR
|
|---|
| 12 | .I $D(DIRUT) K X,Y Q
|
|---|
| 13 | .S ALPBIEN=+Y
|
|---|
| 14 | .S ALPBPTN=Y(0,0)
|
|---|
| 15 | .; get all or just current orders?...
|
|---|
| 16 | .S DIR(0)="SA^A:ALL;C:CURRENT"
|
|---|
| 17 | .S DIR("A")="Report [A]LL or [C]URRENT orders? "
|
|---|
| 18 | .S DIR("B")="CURRENT"
|
|---|
| 19 | .S DIR("?")="[A]LL=all orders in the file, [C]URRENT=orders not yet expired."
|
|---|
| 20 | .W ! D ^DIR K DIR
|
|---|
| 21 | .I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
|
|---|
| 22 | .S ALPBOTYP=Y
|
|---|
| 23 | .;
|
|---|
| 24 | .; print how many days MAR?...
|
|---|
| 25 | .S DIR(0)="NA^3:7"
|
|---|
| 26 | .S DIR("A")="Print how many days MAR? "
|
|---|
| 27 | .S DIR("B")=$$DEFDAYS^ALPBUTL()
|
|---|
| 28 | .S DIR("?")="The default is shown; you may select 3 or 7."
|
|---|
| 29 | .W ! D ^DIR K DIR
|
|---|
| 30 | .I $D(DIRUT) K ALPBOTYP,DIRUT,DTOUT,X,Y Q
|
|---|
| 31 | .S ALPBDAYS=+Y
|
|---|
| 32 | .;
|
|---|
| 33 | .; BCMA Med Log info for how many ?...
|
|---|
| 34 | .S DIR(0)="NA^1:99"
|
|---|
| 35 | .S DIR("B")=$$DEFML^ALPBUTL3()
|
|---|
| 36 | .S DIR("A")="Select how many BCMA Medication Log history: "
|
|---|
| 37 | .S DIR("A",1)=" "
|
|---|
| 38 | .S DIR("?",1)="Select a number of BCMA Medication log entries"
|
|---|
| 39 | .S DIR("?",2)="for each of the patient's orders"
|
|---|
| 40 | .S DIR("?")="They are listed by the most current entry first"
|
|---|
| 41 | .D ^DIR K DIR
|
|---|
| 42 | .I $D(DIRUT) K ALPBOTYP,ALPBWARD,DIRUT,DTOUT,X,Y Q
|
|---|
| 43 | .S ALPBMLOG=Y
|
|---|
| 44 | .;
|
|---|
| 45 | .S %ZIS="Q"
|
|---|
| 46 | .S %ZIS("B")=$$DEFPRT^ALPBUTL()
|
|---|
| 47 | .I %ZIS("B")="" K %ZIS("B")
|
|---|
| 48 | .W ! D ^%ZIS K %ZIS
|
|---|
| 49 | .I POP D Q
|
|---|
| 50 | ..K ALPBIEN,ALPBPTN,POP
|
|---|
| 51 | .;
|
|---|
| 52 | .; output not queued...
|
|---|
| 53 | .I '$D(IO("Q")) D
|
|---|
| 54 | ..U IO
|
|---|
| 55 | ..D DQ
|
|---|
| 56 | ..I IO'=IO(0) D ^%ZISC
|
|---|
| 57 | .;
|
|---|
| 58 | .; set up the Task...
|
|---|
| 59 | .I $D(IO("Q")) D
|
|---|
| 60 | ..S ZTRTN="DQ^ALPBPPAT"
|
|---|
| 61 | ..S ZTIO=ION
|
|---|
| 62 | ..S ZTDESC="PSB INPT PHARM ORDERS FOR "_ALPBPTN
|
|---|
| 63 | ..S ZTSAVE("ALPBDAYS")=""
|
|---|
| 64 | ..S ZTSAVE("ALPBIEN")=""
|
|---|
| 65 | ..S ZTSAVE("ALPBMLOG")=""
|
|---|
| 66 | ..S ZTSAVE("ALPBOTYP")=""
|
|---|
| 67 | ..D ^%ZTLOAD
|
|---|
| 68 | ..D HOME^%ZIS
|
|---|
| 69 | ..W !!,$S(+$G(ZTSK):"Task "_ZTSK_" queued.",1:"ERROR: NOT QUEUED!")
|
|---|
| 70 | ..K IO("Q"),ZTSK
|
|---|
| 71 | .;
|
|---|
| 72 | .K ALPBDAYS,ALPBIEN,ALPBMLOG,ALPBOTYP,ALPBPTN,X,Y
|
|---|
| 73 | K DIRUT,DTOUT,X,Y
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | DQ ; output entry point...
|
|---|
| 77 | K ^TMP($J)
|
|---|
| 78 | ;
|
|---|
| 79 | ; set report date...
|
|---|
| 80 | S ALPBRDAT=$$NOW^XLFDT()
|
|---|
| 81 | S ALPBPT(0)=$G(^ALPB(53.7,ALPBIEN,0))
|
|---|
| 82 | M ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
|
|---|
| 83 | S ALPBPG=1
|
|---|
| 84 | D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
|
|---|
| 85 | F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
|
|---|
| 86 | K ALPBHDR
|
|---|
| 87 | ;
|
|---|
| 88 | ; loop through orders and sort by order status...
|
|---|
| 89 | S ALPBOIEN=0
|
|---|
| 90 | F S ALPBOIEN=$O(^ALPB(53.7,ALPBIEN,2,ALPBOIEN)) Q:'ALPBOIEN D
|
|---|
| 91 | .M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
|
|---|
| 92 | .; if report type is "C"urrent and stop date is less than
|
|---|
| 93 | .; report date, quit...
|
|---|
| 94 | .I ALPBOTYP="C" D Q:'$D(ALPBDATA)
|
|---|
| 95 | ..I $G(ALPBDATA(1))="" K ALPBDATA Q
|
|---|
| 96 | ..I $P(ALPBDATA(1),U,2)<ALPBRDAT K ALPBDATA
|
|---|
| 97 | .S ALPBORDN=$P(ALPBDATA(0),U)
|
|---|
| 98 | .S ALPBOCT=$P($G(ALPBDATA(3)),U,1)
|
|---|
| 99 | .S:$P($G(ALPBDATA(4)),U,3)["PRN" ALPBOCT=ALPBOCT_"P"
|
|---|
| 100 | .S ALPBOST=$$STAT2^ALPBUTL1($P($G(ALPBDATA(1),"XX"),U,3))
|
|---|
| 101 | .S ^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)=ALPBOIEN
|
|---|
| 102 | .K ALPBDATA,ALPBOST,ALPBOCT
|
|---|
| 103 | ;
|
|---|
| 104 | ; loop through the sorted orders...
|
|---|
| 105 | S ALPBOCT=""
|
|---|
| 106 | F S ALPBOCT=$O(^TMP($J,ALPBOCT)) Q:ALPBOCT="" D
|
|---|
| 107 | .S ALPBOST=""
|
|---|
| 108 | .F S ALPBOST=$O(^TMP($J,ALPBOCT,ALPBOST)) Q:ALPBOST="" D
|
|---|
| 109 | ..S ALPBORDN=""
|
|---|
| 110 | ..F S ALPBORDN=$O(^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)) Q:ALPBORDN="" D
|
|---|
| 111 | ...S ALPBOIEN=^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)
|
|---|
| 112 | ...M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
|
|---|
| 113 | ...W !
|
|---|
| 114 | ...D F132^ALPBFRM1(.ALPBDATA,ALPBDAYS,ALPBMLOG,.ALPBFORM,ALPBIEN)
|
|---|
| 115 | ...; paginate?...
|
|---|
| 116 | ...I $Y+ALPBFORM(0)=IOSL!($Y+ALPBFORM(0)>IOSL) D
|
|---|
| 117 | ....W @IOF
|
|---|
| 118 | ....S ALPBPG=ALPBPG+1
|
|---|
| 119 | ....D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
|
|---|
| 120 | ....F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
|
|---|
| 121 | ....W !
|
|---|
| 122 | ....K ALPBHDR
|
|---|
| 123 | ...F I=1:1:ALPBFORM(0) W !,ALPBFORM(I)
|
|---|
| 124 | ...K ALPBDATA,ALPBFORM
|
|---|
| 125 | ..K ALPBORDN
|
|---|
| 126 | .K ALPBOST
|
|---|
| 127 | K ALPBOCT
|
|---|
| 128 | ;
|
|---|
| 129 | ; print footer at end of this patient's record...
|
|---|
| 130 | D FOOT^ALPBFRMU
|
|---|
| 131 | ;
|
|---|
| 132 | K ALPBDAYS,ALPBMLOG,ALPBOIEN,ALPBORDN,ALPBOST,ALPBOTYP,ALPBPG,ALPBPT,ALPBRDAT,^TMP($J)
|
|---|
| 133 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 134 | ;
|
|---|
| 135 | ; write form feed at end if output device is a printer...
|
|---|
| 136 | I $E(IOST)="P" W @IOF
|
|---|
| 137 | Q
|
|---|
