[613] | 1 | PSALEVRP ;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
|
---|
| 11 | LOC 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 | ;
|
---|
| 25 | DISPLOC ;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 | ;
|
---|
| 34 | SELLOC 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 | ;
|
---|
| 50 | MASTER 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 | ;
|
---|
| 56 | DISPMV ;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 | ;
|
---|
| 63 | SELMV ;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 | ;
|
---|
| 73 | TEST G:PSAOUT EXIT
|
---|
| 74 | S PSA=$O(PSALOC("")),PSAMV=$O(PSAMAST(""))
|
---|
| 75 | I PSA="",PSAMV="" G EXIT
|
---|
| 76 | ;
|
---|
| 77 | DEV ;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 | ;
|
---|
| 87 | COMPILE ;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 | ;
|
---|
| 95 | MV 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 | ;
|
---|
| 102 | PRINT ;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 | ;
|
---|
| 127 | EXIT W:$E(IOST,1,2)="C-" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 128 | EXIT1 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 | ;
|
---|
| 133 | HDR ;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
|
---|