PSGWPL ;BHAM ISC/MPH,CML-Print AOU Inventory Pick List ; 29 Dec 93 / 2:30 PM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
I '$D(PSGWSITE) D ^PSGWSET Q:'$D(PSGWSITE) S PSGWFLG=1
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
DIC 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
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
;
EN1 ; PSGWIDA = DA of inventory being edited
K PSGST,PSGW("PO") S PSGPAGE=1,Y=DT X ^DD("DD") S PSGTODAY=Y,NOPRT=0
RD 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
RD2 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
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
DEV 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)=""
I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END^PSGWPL0
U IO G ENQ^PSGWPL0
;
HELP1 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
;
HELP2 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
;
EN2 ;Print Pick List Headings
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
I $P(^PSI(58.19,PSGWIDA,0),"^",4)="" W !!,"AOU INVENTORY GROUP MISSING" Q
W !,"GROUP: " D WRTGRP^PSGWPI2
I PSGPAGE=1 W !!,?83,"INVENTORIED BY ____________________________",!
W !,?10,"ITEM",?51,"STOCK",?58,"QUICK",?71,"ON",?91,"BACKORDERED",?106,"TO BE",?115,"ACT DISPENSED"
W !,?51,"LEVEL",?58,"CODE",?71,"HAND",?105,"DISPENSED",?115,"IF < TO BE",!
F I=1:1:132 W "-"
S PSGPAGE=PSGPAGE+1
W !!,?12,$S($D(^PSI(58.1,PSGDA,0)):$P(^(0),"^"),1:"") I $D(^PSI(58.1,PSGDA,"I")),^("I")]"",^("I")'>DT W " *** INACTIVE ***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWPL 2738 printed Apr 09, 2024@20:44:54 Page 2
PSGWPL ;BHAM ISC/MPH,CML-Print AOU Inventory Pick List ; 29 Dec 93 / 2:30 PM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 IF '$DATA(PSGWSITE)
DO ^PSGWSET
if '$DATA(PSGWSITE)
QUIT
SET PSGWFLG=1
+3 IF $PIECE(PSGWSITE,"^",5)
WRITE !!,?5,"You may not run the Pick List because you have the",!,?5,"""Merge Inventory Sheet and Pick List"" site parameter set to ""YES""."
QUIT
DIC IF '$DATA(PSGWIDA)
SET DIC="^PSI(58.19,"
SET DIC(0)="QEAMNZ"
SET DIC("A")="SELECT DATE/TIME FOR INVENTORY: "
DO ^DIC
KILL DIC
if Y<0
GOTO END^PSGWPL0
SET PSGWIDA=+Y
+1 IF '$DATA(^PSI(58.19,"AINV",PSGWIDA))
WRITE !!,"Pick List can't be run for inventory # ",PSGWIDA,!,"You must first print the inventory sheet",!,"using the Inventory Sheet Print Option.",!
KILL PSGWIDA
GOTO DIC
+2 ;
EN1 ; PSGWIDA = DA of inventory being edited
+1 KILL PSGST,PSGW("PO")
SET PSGPAGE=1
SET Y=DT
XECUTE ^DD("DD")
SET PSGTODAY=Y
SET NOPRT=0
RD READ !,"Print total for each item on pharmacy pick list? Y// ",X:DTIME
if X=""&($TEST)
SET X="Y"
if '$TEST
SET X="^"
if "^"[$EXTRACT(X)
GOTO END^PSGWPL0
IF "YyNn"'[$EXTRACT(X)
DO HELP1
GOTO RD
RD2 IF "Nn"[$EXTRACT(X)
READ !!,"Print sub-total for each item by AOU? Y// ",X1:DTIME
if X1=""
SET (X1,PSGST)="Y"
if "^Nn"[$EXTRACT(X1)!('$TEST)
GOTO END^PSGWPL0
if "Yy"[$EXTRACT(X1)
SET PSGST="Y"
IF "YyNn"'[$EXTRACT(X1)
DO HELP2
GOTO RD2
+1 WRITE !,"Right margin for this printout is 132!",!!
KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
GOTO END^PSGWPL0
DEV IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENQ^PSGWPL0"
SET ZTDESC="Print Pick List"
if $DATA(PSGST)
SET ZTSAVE("PSGST")=""
FOR G="PSGWIDA","PSGTODAY","PSGWSITE","PSGPAGE","NOPRT"
SET ZTSAVE(G)=""
+1 IF $TEST
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
GOTO END^PSGWPL0
+2 USE IO
GOTO ENQ^PSGWPL0
+3 ;
HELP1 WRITE !!,"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.",!
QUIT
+1 ;
HELP2 WRITE !!,"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.",!
QUIT
+1 ;
EN2 ;Print Pick List Headings
+1 if $Y
WRITE @IOF
WRITE !,"WARD STOCK PICK LIST FOR "
SET Y=PSGWIN
XECUTE ^DD("DD")
WRITE ?26,Y," INVENTORY # ",PSGWIDA,?99,PSGTODAY,?120,"PAGE ",PSGPAGE
+2 IF $PIECE(^PSI(58.19,PSGWIDA,0),"^",4)=""
WRITE !!,"AOU INVENTORY GROUP MISSING"
QUIT
+3 WRITE !,"GROUP: "
DO WRTGRP^PSGWPI2
+4 IF PSGPAGE=1
WRITE !!,?83,"INVENTORIED BY ____________________________",!
+5 WRITE !,?10,"ITEM",?51,"STOCK",?58,"QUICK",?71,"ON",?91,"BACKORDERED",?106,"TO BE",?115,"ACT DISPENSED"
+6 WRITE !,?51,"LEVEL",?58,"CODE",?71,"HAND",?105,"DISPENSED",?115,"IF < TO BE",!
+7 FOR I=1:1:132
WRITE "-"
+8 SET PSGPAGE=PSGPAGE+1
+9 WRITE !!,?12,$SELECT($DATA(^PSI(58.1,PSGDA,0)):$PIECE(^(0),"^"),1:"")
IF $DATA(^PSI(58.1,PSGDA,"I"))
IF ^("I")]""
IF ^("I")'>DT
WRITE " *** INACTIVE ***"
+10 QUIT
