source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBPWRD.m@ 1710

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

revised back to 6/30/08 version

File size: 6.4 KB
Line 
1ALPBPWRD ;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCMA BCBU REPORT FOR A SELECTED WARD ;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 ward"
9 .S DIR(0)="FAO^2:10"
10 .S DIR("A")="Select WARD: "
11 .S DIR("?")="^D WARDLIST^ALPBUTL(""C"")"
12 .D ^DIR K DIR
13 .I $D(DIRUT) Q
14 .D WARDSEL^ALPBUTL(Y,.ALPBSEL)
15 .I +$G(ALPBSEL(0))=0 D Q
16 ..W $C(7)
17 ..W " ??"
18 ..D WARDLIST^ALPBUTL("C")
19 ..K ALPBSEL
20 .I +$G(ALPBSEL(0))=1 D
21 ..S ALPBWARD=ALPBSEL(1)
22 ..W " ",ALPBWARD
23 ..K ALPBSEL
24 .I +$G(ALPBSEL(0))>1 D I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
25 ..S ALPBX=0
26 ..F S ALPBX=$O(ALPBSEL(ALPBX)) Q:'ALPBX W !?2,$J(ALPBX,2)," ",ALPBSEL(ALPBX)
27 ..K ALPBX
28 ..S DIR(0)="NA^1:"_ALPBSEL(0)
29 ..S DIR("A")="Select Ward from the list (1-"_ALPBSEL(0)_"): "
30 ..W ! D ^DIR K DIR
31 ..I $D(DIRUT) K ALPBSEL Q
32 ..S ALPBWARD=ALPBSEL(+Y)
33 ..K ALPBSEL
34 .;
35 .; get all or just current orders?...
36 .S DIR(0)="SA^A:ALL;C:CURRENT"
37 .S DIR("A")="Report [A]LL or [C]URRENT orders? "
38 .S DIR("B")="CURRENT"
39 .S DIR("?")="[A]LL=all orders in the file, [C]URRENT=orders not yet expired."
40 .W ! D ^DIR K DIR
41 .I $D(DIRUT) K ALPBWARD,DIRUT,DTOUT,X,Y Q
42 .S ALPBOTYP=Y
43 .;
44 .;SORT BY NAME OR ROOM/BED added 6/23/05
45 .S DIR(0)="SA^N:Name;R:Room/Bed"
46 .S DIR("A")="Sort Patients by [N]ame or [R]oom/Bed? "
47 .S DIR("B")="Room/bed"
48 .S DIR("?")="Sort by [N]ame or [R]oom Bed"
49 .W ! D ^DIR K DIR
50 .I $D(DIRUT) K ALPBWARD,DIRUT,DTOUT,X,Y Q
51 .S ALPBSORT=Y
52 .;
53 .; print how many days MAR?...
54 .S DIR(0)="NA^1:7"
55 .S DIR("A")="Print how many days MAR? "
56 .S DIR("B")=$$DEFDAYS^ALPBUTL()
57 .S DIR("?")="The default is shown; you may enter 3 or 7."
58 .W ! D ^DIR K DIR
59 .I $D(DIRUT) K ALPBOTYP,DIRUT,DTOUT,X,Y Q
60 .S ALPBDAYS=+Y
61 .;
62 .; BCMA Med Log info for how many ?...
63 .S DIR(0)="NA^1:99"
64 .S DIR("B")=$$DEFML^ALPBUTL3()
65 .S DIR("A")="Select how many BCMA Medication Log history: "
66 .S DIR("A",1)=" "
67 .S DIR("?",1)="Select a number of BCMA Medication log entries"
68 .S DIR("?",2)="for each of the patient's orders"
69 .S DIR("?")="They are listed by the most current entry first"
70 .D ^DIR K DIR
71 .I $D(DIRUT) K ALPBOTYP,ALPBWARD,DIRUT,DTOUT,X,Y Q
72 .S ALPBMLOG=Y
73 .;
74 .S %ZIS="Q"
75 .S %ZIS("B")=$$DEFPRT^ALPBUTL()
76 .I %ZIS("B")="" K %ZIS("B")
77 .W ! D ^%ZIS K %ZIS
78 .I POP D Q
79 ..W $C(7)
80 ..K ALPBMLOG,ALPBOTYP,ALPBWARD,POP
81 .;
82 .; output not queued...
83 .I '$D(IO("Q")) D
84 ..U IO
85 ..D DQ
86 ..I IO'=IO(0) D ^%ZISC
87 .;
88 .; set up the Task...
89 .I $D(IO("Q")) D
90 ..S ZTRTN="DQ^ALPBPWRD"
91 ..S ZTDESC="PSB INPT PHARM ORDERS FOR WARD "_ALPBWARD
92 ..S ZTSAVE("ALPBDAYS")=""
93 ..S ZTSAVE("ALPBWARD")=""
94 ..S ZTSAVE("ALPBMLOG")=""
95 ..S ZTSAVE("ALPBOTYP")=""
96 ..S ZTSAVE("ALPBSORT")=""
97 ..S ZTIO=ION
98 ..D ^%ZTLOAD
99 ..D HOME^%ZIS
100 ..W !,$S($G(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
101 ..K IO("Q"),ZTSK
102 .K ALPBDAYS,ALPBMLOG,ALPBOTYP,ALPBWARD
103 K DIRUT,DTOUT,X,Y
104 Q
105 ;
106DQ ; output entry point...
107 K ^TMP($J)
108 ;
109 ; set report date... SED 11/4/03
110 S ALPBRDAT=$S(ALPBOTYP="C":$$NOW^XLFDT(),1:"")
111 ;
112 ; loop through ward cross reference in 53.7...
113 S ALPBPTN=""
114 F S ALPBPTN=$O(^ALPB(53.7,"AW",ALPBWARD,ALPBPTN)) Q:ALPBPTN="" D
115 .S ALPBIEN=0
116 .F S ALPBIEN=$O(^ALPB(53.7,"AW",ALPBWARD,ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
117 ..D ORDS^ALPBUTL(ALPBIEN,ALPBRDAT,.ALPBORDS)
118 ..I +ALPBORDS(0)'>0 K ALPBORDS Q
119 ..I $G(ALPBPDAT(0))="" S ALPBPDAT(0)=$G(^ALPB(53.7,ALPBIEN,0))
120 ..S ALPBOIEN=0
121 ..F S ALPBOIEN=$O(ALPBORDS(ALPBOIEN)) Q:'ALPBOIEN D
122 ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,2,ALPBOIEN,1))
123 ...S ALPBOCT=$P($G(^ALPB(53.7,ALPBIEN,2,ALPBOIEN,3)),U,1)
124 ...S:$P($G(^ALPB(53.7,ALPBIEN,2,ALPBOIEN,4)),U,3)["PRN" ALPBOCT=ALPBOCT_"P"
125 ...; if report is for "C"urrent, check stop date and quit if
126 ...; stop date is less than report date...
127 ...I ALPBOTYP="C"&($P(ALPBDATA,U,2)<ALPBRDAT) K ALPBDATA Q
128 ...S ALPBORDN=ALPBORDS(ALPBOIEN)
129 ...S ALPBOST=$$STAT2^ALPBUTL1(ALPBORDS(ALPBOIEN,2))
130 ...I '$D(^TMP($J,ALPBPTN)) S ^TMP($J,ALPBPTN)=ALPBIEN
131 ...S ^TMP($J,ALPBPTN,ALPBOCT,ALPBOST,ALPBORDN)=ALPBOIEN
132 ...K ALPBDATA,ALPBORDN,ALPBOST
133 ..K ALPBOIEN,ALPBORDS,ALPBPDAT
134 .K ALPBIEN
135 K ALPBPTN
136 ;
137 ; Sort by Patient Name or room/bed capability added 6/23/05 KFOX
138 S ALPBPG=0
139 S ALPBPTN=""
140 I ALPBSORT="N" D
141 .F S ALPBPTN=$O(^TMP($J,ALPBPTN)) Q:ALPBPTN="" S ALPBIEN=^TMP($J,ALPBPTN) D PRT
142 ;SORT BY ROOM/BED
143 I ALPBSORT="R" D
144 .S ALPBD="",ALPRM=""
145 .F S ALPBPTN=$O(^TMP($J,ALPBPTN)) Q:ALPBPTN="" D
146 ..I ALPBPTN="BCBU" S ALPBPTN=$O(^TMP($J,ALPBPTN)) ;SKIP "BCBU" SUBSCRIBE
147 ..S ALPBIEN=^TMP($J,ALPBPTN) S ALPRM=$P($G(^ALPB(53.7,ALPBIEN,0)),"^",6),ALPBD=$P($G(^ALPB(53.7,ALPBIEN,0)),"^",7)
148 ..I ALPBD="" S ALPB="NONE" I ALPRM="" S ALPB="NONE" ;INCASE NO ROOM AND BED YET
149 ..S ^TMP($J,"BCBU",ALPRM,ALPRM,ALPBD,ALPBPTN)=ALPBIEN
150 .S ALPRM1="" F S ALPRM1=$O(^TMP($J,"BCBU",ALPRM1)) Q:ALPRM1="" D
151 ..S ALPRM="" F S ALPRM=$O(^TMP($J,"BCBU",ALPRM1,ALPRM)) Q:ALPRM="" D
152 ...S ALPBD="" F S ALPBD=$O(^TMP($J,"BCBU",ALPRM1,ALPRM,ALPBD)) Q:ALPBD="" D
153 ....S ALPBPTN="" F S ALPBPTN=$O(^TMP($J,"BCBU",ALPRM1,ALPRM,ALPBD,ALPBPTN)) Q:ALPBPTN="" D
154 .....S ALPBIEN=$G(^TMP($J,"BCBU",ALPRM1,ALPRM,ALPBD,ALPBPTN)) D PRT
155 D DONE
156 Q
157PRT S ALPBPDAT(0)=$G(^ALPB(53.7,ALPBIEN,0))
158 M ALPBPDAT(1)=^ALPB(53.7,ALPBIEN,1)
159 I ALPBPG=0 D PAGE
160 S ALPBOCT=""
161 F S ALPBOCT=$O(^TMP($J,ALPBPTN,ALPBOCT)) Q:ALPBOCT="" D
162 .S ALPBOST=""
163 .F S ALPBOST=$O(^TMP($J,ALPBPTN,ALPBOCT,ALPBOST)) Q:ALPBOST="" D
164 ..S ALPBORDN=""
165 ..F S ALPBORDN=$O(^TMP($J,ALPBPTN,ALPBOCT,ALPBOST,ALPBORDN)) Q:ALPBORDN="" D
166 ...S ALPBOIEN=^TMP($J,ALPBPTN,ALPBOCT,ALPBOST,ALPBORDN)
167 ...; get and print this order's data...
168 ...M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
169 ...D F132^ALPBFRM1(.ALPBDATA,ALPBDAYS,ALPBMLOG,.ALPBFORM,ALPBIEN)
170 ...;D F132^ALPBFRM1(.ALPBDATA,ALPBDAYS,.ALPBFORM)
171 ...I $Y+ALPBFORM(0)=IOSL!($Y+ALPBFORM(0)>IOSL) D PAGE
172 ...F ALPBX=1:1:ALPBFORM(0) W !,ALPBFORM(ALPBX)
173 ...K ALPBDATA,ALPBFORM,ALPBOIEN,ALPBX
174 ..K ALPBORDN
175 .K ALPBOST
176 K ALPBOCT
177 ; print footer at end of this patient's record...
178 I $Y+10>IOSL D PAGE
179 W !!
180 D FOOT^ALPBFRMU
181 ;Print a blank page between patient
182 W @IOF
183 S ALPBPG=0
184 K ALPBPDAT
185 Q
186 ;K ALPBIEN,ALPBPDAT KILLING ALPBIEN WILL BREAK SORT BY ROOM/BED
187 ;
188DONE ;
189 K ALPBDAYS,ALPBMLOG,ALPBOTYP,ALPBPG,ALPBPTN,ALPBRDAT,ALPBWARD,^TMP($J),ALPRM,ALPRM1,ALPBD,ALPBIEN,ALPBSORT
190 I $D(ZTQUEUED) S ZTREQ="@"
191 Q
192 ;
193PAGE ; print page header for patient...
194 W @IOF
195 S ALPBPG=ALPBPG+1
196 D HDR^ALPBFRMU(.ALPBPDAT,ALPBPG,.ALPBHDR)
197 F ALPBX=1:1:ALPBHDR(0) W !,ALPBHDR(ALPBX)
198 K ALPBHDR,ALPBX
199 Q
Note: See TracBrowser for help on using the repository browser.