source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALEVRP.m@ 1314

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1PSALEVRP ;BIR/LTL,JMB-Stock and Reorder Report ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
3 ;This routine prints a report of all drugs with their stock and reorder
4 ;levels in a pharmacy location.
5 ;
6 ;References to ^PSDRUG( are covered by IA #2095
7 ;
8 D LOC G MASTER
9 ;
10 ;Gets locations
11LOC S PSAOUT=0,PSALOC=+$O(^PSD(58.8,"ADISP","P",0))
12 I 'PSALOC W !!?5,"No Drug Accountability location has been created yet." S PSAOUT=1 G MASTER
13 ;
14 ;Collect locations in alpha order
15 S (PSACNT,PSALOC)=0 W !
16 F S PSALOC=+$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
17 .Q:'$D(^PSD(58.8,PSALOC,0))!($P($G(^PSD(58.8,PSALOC,0)),"^")="")
18 .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
19 .Q:'$O(^PSD(58.8,PSALOC,1,0)) D SITES^PSAUTL1
20 .S PSACNT=PSACNT+1
21 .S PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=$P(^(0),"^",3)_"^"_$P(^(0),"^",10)_"^"_+$G(^PSD(58.8,PSALOC,"I"))
22 S PSACHK=$O(PSALOCA("")) I PSACHK="" G MASTER
23 Q:$G(PSAHIS)&(PSACNT=1)
24 ;
25DISPLOC ;Displays the available pharmacy locations.
26 W @IOF,!,"Choose one or many pharmacy locations:",!
27 S PSACNT=0,PSALOCN=""
28 F S PSALOCN=$O(PSALOCA(PSALOCN)) Q:PSALOCN="" D
29 .S PSALOC=0 F S PSALOC=$O(PSALOCA(PSALOCN,PSALOC)) Q:'PSALOC D
30 ..S PSACNT=PSACNT+1,PSAMENU(PSACNT,PSALOCN,PSALOC)=""
31 ..W !,$J(PSACNT,2)
32 ..W:$L(PSALOCN)>76 ?4,$P(PSALOCN,"(IP)",1)_"(IP)",!?21,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 ?4,PSALOCN
33 ;
34SELLOC W ! S DIR(0)="LO^1:"_PSACNT,DIR("A")="Select PHARMACY LOCATION",DIR("?")="Enter the number(s) of the Pharmacy Location",DIR("??")="^D HELP^PSAUTL3"
35 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 G EXIT
36 Q:Y=""&('$G(PSAHIS)) I Y="",$G(PSAHIS) S PSAOUT=1 Q
37 S PSASEL=Y
38 F PSAPC=1:1 S PSANUM=+$P(PSASEL,",",PSAPC) Q:'PSANUM D
39 .S PSALOCN=$O(PSAMENU(PSANUM,"")),PSALOC=$O(PSAMENU(PSANUM,PSALOCN,0))
40 .S PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC)
41 ;
42 S PSACHK=$O(PSALOC(""))
43 I PSACHK="",'PSALOC W !,"There are no active pharmacy locations." G EXIT1
44 W ! S PSALOCN="" F S PSALOCN=$O(PSALOC(PSALOCN)) Q:PSALOCN=""!(PSAOUT) S PSALOC=0 F S PSALOC=$O(PSALOC(PSALOCN,PSALOC)) Q:'PSALOC!(PSAOUT) D
45 .I '$O(^PSD(58.8,PSALOC,1,0)) D
46 ..W:$L(PSALOCN)>79 !!,$P(PSALOCN,"(IP)",1)_"(IP)",!!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<80 !!,PSALOCN
47 ..W !,"There are no drugs in the pharmacy location."
48 Q
49 ;
50MASTER G:'$D(^XUSEC("PSA ORDERS",DUZ)) TEST S (PSAMVN,PSAMV)=0
51 F S PSAMV=+$O(^PSD(58.8,"ADISP","M",PSAMV)) Q:'PSAMV D
52 .I +$G(^PSD(58.8,PSAMV,"I")),+^PSD(58.8,PSAMV,"I")'>DT Q
53 .S PSAMVN=PSAMVN+1,PSAMV($P(^PSD(58.8,PSAMV,0),"^"),PSAMV)=""
54 G:'PSAMVN TEST
55 ;
56DISPMV ;Displays active master vaults
57 W @IOF,!,"Choose one or many master vaults:",!
58 S PSA=0,PSAMVA="" F S PSAMVA=$O(PSAMV(PSAMVA)) Q:PSAMVA="" D
59 .S PSAMV=0 F S PSAMV=$O(PSAMV(PSAMVA,PSAMV)) Q:'PSAMV D
60 ..S PSA=PSA+1,PSAVAULT(PSA,PSAMVA,PSAMV)="" W !,$J(PSA,2)_".",?4,PSAMVA
61 K PSAMV
62 ;
63SELMV ;Select displayed master vaults
64 W ! S DIR(0)="LO^1:"_PSA,DIR("A")="Select Master Vault",DIR("?")="Select the Master Vault that received the invoice's drugs",DIR("??")="^D MV^PSAPROC"
65 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
66 G:Y="" TEST S PSASEL=Y
67 F PSAPC=1:1 S PSA=+$P(PSASEL,",",PSAPC) Q:'PSA D
68 .S PSAMVA="",PSAMVA=$O(PSAVAULT(PSA,PSAMVA)) Q:PSAMVA=""
69 .S PSAMVIEN=+$O(PSAVAULT(PSA,PSAMVA,0)) Q:'PSAMVIEN
70 .S PSAMAST(PSAMVA,PSAMVIEN)=""
71 K PSAVAULT
72 ;
73TEST G:PSAOUT EXIT
74 S PSA=$O(PSALOC("")),PSAMV=$O(PSAMAST(""))
75 I PSA="",PSAMV="" G EXIT
76 ;
77DEV ;Asks device & queueing info
78 W !!,"Each pharmacy location can contain all drugs in the DRUG file. Therefore,",!,"this report could be very long. It is advised to queue the report to run",!,"during non-critical hours.",!
79 K IO("Q") K %ZIS,IOP,POP S %ZIS="Q",%ZIS("B")=""
80 D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
81 I $D(IO("Q")) D G EXIT
82 .N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
83 .S ZTRTN="COMPILE^PSALEVRP",ZTDESC="Drug Acct. - Stock and Reorder Report"
84 .S:PSA'="" ZTSAVE("PSALOC(")="" S:PSAMV'="" ZTSAVE("PSAMAST(")=""
85 .D ^%ZTLOAD
86 ;
87COMPILE ;Compiles data
88 S PSA=$O(PSALOC("")) G:PSA="" MV
89 S PSALOCN="" F S PSALOCN=$O(PSALOC(PSALOCN)) Q:PSALOCN="" D
90 .S PSALOC=0 F S PSALOC=$O(PSALOC(PSALOCN,PSALOC)) Q:'PSALOC D
91 ..S PSADRG=0 F S PSADRG=+$O(^PSD(58.8,PSALOC,1,PSADRG)) Q:'PSADRG D
92 ...Q:'$D(^PSD(58.8,PSALOC,1,PSADRG,0))!($P($G(^PSDRUG(PSADRG,0)),"^")="")
93 ...S ^TMP("PSALEV",$J,1,PSALOC,$P(^PSDRUG(PSADRG,0),"^"))=+$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3)_"^"_+$P(^(0),"^",5)
94 ;
95MV S PSA=$O(PSAMAST("")) G:PSA="" PRINT
96 S PSAMVN="" F S PSAMVN=$O(PSAMAST(PSAMVN)) Q:PSAMVN="" D
97 .S PSAMV=0 F S PSAMV=$O(PSAMAST(PSAMVN,PSAMV)) Q:'PSAMV D
98 ..S PSADRG=0 F S PSADRG=+$O(^PSD(58.8,PSAMV,1,PSADRG)) Q:'PSADRG D
99 ...Q:'$D(^PSD(58.8,PSAMV,1,PSADRG,0))!($P($G(^PSDRUG(PSADRG,0)),"^")="")
100 ...S ^TMP("PSALEV",$J,2,PSAMV,$P(^PSDRUG(PSADRG,0),"^"))=+$P(^PSD(58.8,PSAMV,1,PSADRG,0),"^",3)_"^"_+$P(^(0),"^",5)
101 ;
102PRINT ;Prints report
103 D NOW^%DTC S PSARUN=%,PSARUN=$E(PSARUN,4,5)_"/"_$E(PSARUN,6,7)_"/"_$E(PSARUN,2,3)_"@"_$E($P(PSARUN,".",2),1,2)_":"_$E($P(PSARUN,".",2),3,4)
104 S PSAPG=0,PSASLN="",$P(PSASLN,"-",80)="",PSAOUT=0 K Y
105 S PSAFIRST=1,PSALOC=0 F S PSALOC=+$O(^TMP("PSALEV",$J,1,PSALOC)) Q:'PSALOC!(PSAOUT) D
106 .D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
107 .I PSAFIRST D HDR Q:PSAOUT S PSAFIRST=0
108 .S PSADRG="" F S PSADRG=$O(^TMP("PSALEV",$J,1,PSALOC,PSADRG)) Q:PSADRG=""!(PSAOUT) D
109 ..I $Y+5>IOSL D HDR Q:PSAOUT
110 ..S PSASTOCK=$P(^TMP("PSALEV",$J,1,PSALOC,PSADRG),"^"),PSAREORD=$P(^(PSADRG),"^",2)
111 ..W !,PSADRG
112 ..W ?(45-$L($P(PSASTOCK,".",2))),$J(PSASTOCK,9,+$L($P(PSASTOCK,".",2)))
113 ..W ?(67-$L($P(PSAREORD,".",2))),$J(PSAREORD,9,+$L($P(PSAREORD,".",2)))
114 ;
115 S PSA=$O(^TMP("PSALEV",$J,2,"")) G:PSA="" EXIT
116 S PSAFIRST=1,PSAMV=0
117 F S PSAMV=+$O(^TMP("PSALEV",$J,2,PSAMV)) Q:'PSAMV!(PSAOUT) D S PSAFIRST=1
118 .I PSAFIRST D HDR Q:PSAOUT S PSAFIRST=0
119 .S PSADRG="" F S PSADRG=$O(^TMP("PSALEV",$J,2,PSAMV,PSADRG)) Q:PSADRG=""!(PSAOUT) D
120 ..I $Y+5>IOSL D HDR Q:PSAOUT
121 ..S PSASTOCK=$P(^TMP("PSALEV",$J,2,PSAMV,PSADRG),"^"),PSAREORD=$P(^(PSADRG),"^",2)
122 ..W !,PSADRG
123 ..W ?(45-$L($P(PSASTOCK,".",2))),$J(PSASTOCK,9,+$L($P(PSASTOCK,".",2)))
124 ..W ?(67-$L($P(PSAREORD,".",2))),$J(PSAREORD,9,+$L($P(PSAREORD,".",2)))
125 I 'PSAOUT,$E(IOST,1,2)="C-" S PSAOUT=1 D END^PSAPROC G:PSAOUT EXIT1
126 ;
127EXIT W:$E(IOST,1,2)="C-" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
128EXIT1 K IO("Q"),^TMP("PSALEV",$J)
129 K %,%ZIS,DIR,DTOUT,DUOUT,PSA,PSACHK,PSACNT,PSACOMB,PSADRG,PSAFIRST,PSAISIT,PSAISITN,PSALOC,PSALOCA,PSALOCN,PSAMAST,PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVN
130 K PSANUM,PSAOSIT,PSAOSITN,PSAOUT,PSAPC,PSAPG,PSAREORD,PSARUN,PSASEL,PSASLN,PSASTOCK,PSAVAULT,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
131 Q
132 ;
133HDR ;Report header
134 I $E(IOST,1,2)="C-" W:'PSAPG @IOF D:+PSAPG END^PSAPROC Q:PSAOUT
135 I $E(IOST)'="C",+PSAPG W @IOF
136 S PSAPG=PSAPG+1
137 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE "_PSAPG
138 W !?25,"STOCK AND REORDER LEVEL REPORT",!
139 I $E(IOST)'="C" W "RUN: "_PSARUN
140 I $G(PSALOC) W ?31,"PHARMACY LOCATION" W:$L(PSALOCN)>79 !!,$P(PSALOCN,"(IP)",1)_"(IP)",!!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<80 !!,PSALOCN
141 I $G(PSAMV) W !,"MASTER VAULT: "_$P($G(^PSD(58.8,PSAMV,0)),"^")
142 W !!,"DRUG",?43,"STOCK LEVEL",?63,"REORDER LEVEL",!,PSASLN
143 Q
Note: See TracBrowser for help on using the repository browser.