source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWPL.m@ 1169

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PSGWPL ;BHAM ISC/MPH,CML-Print AOU Inventory Pick List ; 29 Dec 93 / 2:30 PM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3 I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
4 I $P(PSGWSITE,"^",5) W !!,?5,"You may not run the Pick List because you have the",!,?5,"""Merge Inventory Sheet and Pick List"" site parameter set to ""YES""." Q
5DIC I '$D(PSGWIDA) S DIC="^PSI(58.19,",DIC(0)="QEAMNZ",DIC("A")="SELECT DATE/TIME FOR INVENTORY: " D ^DIC K DIC G:Y<0 END^PSGWPL0 S PSGWIDA=+Y
6 I '$D(^PSI(58.19,"AINV",PSGWIDA)) W !!,"Pick List can't be run for inventory # ",PSGWIDA,!,"You must first print the inventory sheet",!,"using the Inventory Sheet Print Option.",! K PSGWIDA G DIC
7 ;
8EN1 ; PSGWIDA = DA of inventory being edited
9 K PSGST,PSGW("PO") S PSGPAGE=1,Y=DT X ^DD("DD") S PSGTODAY=Y,NOPRT=0
10RD R !,"Print total for each item on pharmacy pick list? Y// ",X:DTIME S:X=""&($T) X="Y" S:'$T X="^" G:"^"[$E(X) END^PSGWPL0 I "YyNn"'[$E(X) D HELP1 G RD
11RD2 I "Nn"[$E(X) R !!,"Print sub-total for each item by AOU? Y// ",X1:DTIME S:X1="" (X1,PSGST)="Y" G:"^Nn"[$E(X1)!('$T) END^PSGWPL0 S:"Yy"[$E(X1) PSGST="Y" I "YyNn"'[$E(X1) D HELP2 G RD2
12 W !,"Right margin for this printout is 132!",!! K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END^PSGWPL0
13DEV I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSGWPL0",ZTDESC="Print Pick List" S:$D(PSGST) ZTSAVE("PSGST")="" F G="PSGWIDA","PSGTODAY","PSGWSITE","PSGPAGE","NOPRT" S ZTSAVE(G)=""
14 I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END^PSGWPL0
15 U IO G ENQ^PSGWPL0
16 ;
17HELP1 W !!,"Enter ""N"" or ""n"" for NO, or press return to accept the default answer of yes.",!,"Print total for each item on pharmacy pick list will give totals",!,"without showing sub-total breakdown for each area of use.",! Q
18 ;
19HELP2 W !!,"Enter ""N"" or ""n"" for NO, or press return to accept the default answer of yes.",!,"Print sub-total for each item by AOU will give a total to dispense,",!,"as well as a sub-total for each AOU requesting that item.",! Q
20 ;
21EN2 ;Print Pick List Headings
22 W:$Y @IOF W !,"WARD STOCK PICK LIST FOR " S Y=PSGWIN X ^DD("DD") W ?26,Y," INVENTORY # ",PSGWIDA,?99,PSGTODAY,?120,"PAGE ",PSGPAGE
23 I $P(^PSI(58.19,PSGWIDA,0),"^",4)="" W !!,"AOU INVENTORY GROUP MISSING" Q
24 W !,"GROUP: " D WRTGRP^PSGWPI2
25 I PSGPAGE=1 W !!,?83,"INVENTORIED BY ____________________________",!
26 W !,?10,"ITEM",?51,"STOCK",?58,"QUICK",?71,"ON",?91,"BACKORDERED",?106,"TO BE",?115,"ACT DISPENSED"
27 W !,?51,"LEVEL",?58,"CODE",?71,"HAND",?105,"DISPENSED",?115,"IF < TO BE",!
28 F I=1:1:132 W "-"
29 S PSGPAGE=PSGPAGE+1
30 W !!,?12,$S($D(^PSI(58.1,PSGDA,0)):$P(^(0),"^"),1:"") I $D(^PSI(58.1,PSGDA,"I")),^("I")]"",^("I")'>DT W " *** INACTIVE ***"
31 Q
Note: See TracBrowser for help on using the repository browser.