source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBPPAT.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1ALPBPPAT ;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 ;
76DQ ; 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
Note: See TracBrowser for help on using the repository browser.