source: FOIAVistA/tag/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBPALL.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1ALPBPALL ;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCMA BACLUP REPORT FOR ALL WARDS ;01/01/03
2 ;;3.0;BAR CODE MED ADMIN;**8,29**;Mar 2004
3 ;
4 ; based on original code by FD@NJHCS, May 2002
5 ;
6 W !,"Inpatient Pharmacy Orders for all wards"
7 ;
8 ; get all or just current orders?...
9 S DIR(0)="SA^A:ALL;C:CURRENT"
10 S DIR("A")="Report [A]LL or [C]URRENT orders? "
11 S DIR("B")="CURRENT"
12 S DIR("?")="[A]LL=all orders in the file, [C]URRENT=orders not yet expired."
13 W ! D ^DIR K DIR
14 I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
15 S ALPBOTYP=Y
16 ;
17 ; print how many days MAR?...
18 S DIR(0)="NA^1:7"
19 S DIR("A")="Print how many days MAR? "
20 S DIR("B")=$$DEFDAYS^ALPBUTL()
21 S DIR("?")="The default is shown; you may choose 3 or 7."
22 W ! D ^DIR K DIR
23 I $D(DIRUT) K ALPBOTYP,DIRUT,DTOUT,X,Y Q
24 S ALPBDAYS=+Y
25 ;
26 ; BCMA Med Log info for how many ?...
27 S DIR(0)="NA^1:99"
28 S DIR("B")=$$DEFML^ALPBUTL3()
29 S DIR("A")="Select how many BCMA Medication Log history: "
30 S DIR("A",1)=" "
31 S DIR("?",1)="Select a number of BCMA Medication log entries"
32 S DIR("?",2)="for each of the patient's orders"
33 S DIR("?")="They are listed by the most current entry first"
34 D ^DIR K DIR
35 I $D(DIRUT) K ALPBOTYP,ALPBWARD,DIRUT,DTOUT,X,Y Q
36 S ALPBMLOG=Y
37 ;
38 S %ZIS="Q"
39 S %ZIS("B")=$$DEFPRT^ALPBUTL()
40 I %ZIS("B")="" K %ZIS("B")
41 W ! D ^%ZIS K %ZIS
42 I POP K POP Q
43 ;
44 ; output not queued...
45 I '$D(IO("Q")) D
46 .U IO
47 .D DQ
48 .I IO'=IO(0) D ^%ZISC
49 ;
50 ; set up the task...
51 I $D(IO("Q")) D
52 .S ZTRTN="DQ^ALPBPALL"
53 .S ZTDESC="PSB INPT PHARM ORDER FOR ALL WARDS"
54 .S ZTIO=ION
55 .S ZTSAVE("ALPBMLOG")=""
56 .S ZTSAVE("ALPBOTYP")=""
57 .S ZTSAVE("ALPBDAYS")=""
58 .D ^%ZTLOAD
59 .D HOME^%ZIS
60 .W !,$S($G(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
61 .K IO("Q"),ZTSK
62 K ALPBDAYS,ALPBMLOG,ALPBOTYP
63 Q
64 ;
65DQ ; output entry point...
66 K ^TMP($J)
67 ;
68 ; set report date...MOD 11/03/03 SED
69 S ALPBRDAT=$S(ALPBOTYP="C":$$NOW^XLFDT(),1:"")
70 ;
71 ; loop through ward cross reference in 53.7...
72 S ALPBWARD=""
73 F S ALPBWARD=$O(^ALPB(53.7,"AW",ALPBWARD)) Q:ALPBWARD="" D
74 .S ALPBPTN=""
75 .F S ALPBPTN=$O(^ALPB(53.7,"AW",ALPBWARD,ALPBPTN)) Q:ALPBPTN="" D
76 ..S ALPBIEN=0
77 ..F S ALPBIEN=$O(^ALPB(53.7,"AW",ALPBWARD,ALPBPTN,ALPBIEN)) Q:'ALPBIEN D
78 ...D ORDS^ALPBUTL(ALPBIEN,ALPBRDAT,.ALPBORDS)
79 ...I +ALPBORDS(0)'>0 K ALPBORDS Q
80 ...S ALPBOIEN=0
81 ...F S ALPBOIEN=$O(ALPBORDS(ALPBOIEN)) Q:'ALPBOIEN D
82 ....S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,2,ALPBOIEN,1))
83 ....I ALPBOTYP="C"&($P(ALPBDATA,U,2)<ALPBRDAT) K ALPBDATA Q
84 ....S ALPBOCT=$P($G(^ALPB(53.7,ALPBIEN,2,ALPBOIEN,3)),U,1)
85 ....S:$P($G(^ALPB(53.7,ALPBIEN,2,ALPBOIEN,4)),U,3)["PRN" ALPBOCT=ALPBOCT_"P"
86 ....S ALPBORDN=ALPBORDS(ALPBOIEN)
87 ....S ALPBOST=$$STAT2^ALPBUTL1(ALPBORDS(ALPBOIEN,2))
88 ....I '$D(^TMP($J,ALPBWARD,ALPBPTN)) S ^TMP($J,ALPBWARD,ALPBPTN)=ALPBIEN
89 ....S ^TMP($J,ALPBWARD,ALPBPTN,ALPBOCT,ALPBOST,ALPBORDN)=ALPBOIEN
90 ....K ALPBDATA,ALPBORDN,ALPBOST,ALPBOCT
91 ...K ALPBOIEN,ALPBORDS
92 ..K ALPBIEN
93 .K ALPBPTN
94 K ALPBWARD
95 ;
96 ; process through our sorted list...
97 S ALPBPG=0
98 S ALPBWARD=""
99 F S ALPBWARD=$O(^TMP($J,ALPBWARD)) Q:ALPBWARD="" D
100 .S ALPBPTN=""
101 .F S ALPBPTN=$O(^TMP($J,ALPBWARD,ALPBPTN)) Q:ALPBPTN="" D
102 ..S ALPBIEN=+^TMP($J,ALPBWARD,ALPBPTN)
103 ..S ALPBPDAT(0)=$G(^ALPB(53.7,ALPBIEN,0))
104 ..M ALPBPDAT(1)=^ALPB(53.7,ALPBIEN,1)
105 ..; paginate between patients...
106 ..I ALPBPG=0 D PAGE
107 ..S ALPBOCT=""
108 ..F S ALPBOCT=$O(^TMP($J,ALPBWARD,ALPBPTN,ALPBOCT)) Q:ALPBOCT="" D
109 ...S ALPBOST=""
110 ...F S ALPBOST=$O(^TMP($J,ALPBWARD,ALPBPTN,ALPBOCT,ALPBOST)) Q:ALPBOST="" D
111 ....S ALPBORDN=""
112 ....F S ALPBORDN=$O(^TMP($J,ALPBWARD,ALPBPTN,ALPBOCT,ALPBOST,ALPBORDN)) Q:ALPBORDN="" D
113 .....S ALPBOIEN=^TMP($J,ALPBWARD,ALPBPTN,ALPBOCT,ALPBOST,ALPBORDN)
114 .....; get and print this order's data...
115 .....M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
116 .....D F132^ALPBFRM1(.ALPBDATA,ALPBDAYS,ALPBMLOG,.ALPBFORM,ALPBIEN)
117 .....I $Y+ALPBFORM(0)>IOSL D PAGE
118 .....S ALPBX=0
119 .....F S ALPBX=$O(ALPBFORM(ALPBX)) Q:'ALPBX W !,ALPBFORM(ALPBX)
120 .....K ALPBDATA,ALPBFORM,ALPBOIEN,ALPBX
121 ....K ALPBORDN
122 ...K ALPBOST
123 ..K ALPBIEN,ALPBPDAT,ALPBOCT
124 ..S ALPBPG=0
125 ..; print footer at end of this patient's record...
126 ..D FOOT^ALPBFRMU
127 ..;Print a blank page between patients
128 ..W @IOF
129 .K ALPBPTN
130 ;
131 K ALPBDAYS,ALPBMLOG,ALPBOTYP,ALPBPG,ALPBRDAT,ALPBWARD,^TMP($J)
132 I $D(ZTQUEUED) S ZTREQ="@"
133 Q
134 ;
135PAGE ; paginate and print header for a patient...
136 W @IOF
137 ; increment page count...
138 S ALPBPG=ALPBPG+1
139 D HDR^ALPBFRMU(.ALPBPDAT,ALPBPG,.ALPBHDR)
140 S ALPBX=0
141 F S ALPBX=$O(ALPBHDR(ALPBX)) Q:'ALPBX W !,ALPBHDR(ALPBX)
142 K ALPBHDR,ALPBX
143 Q
Note: See TracBrowser for help on using the repository browser.