PSGWLSI ;BHAM ISC/PTD,CML-List Active Stock Items for AOU(s) ; 05/25/90 8:50
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
D SEL^PSGWUTL1 G:'$D(SEL) END I SEL="I" F JJ=0:0 S JJ=$O(AOULP(JJ)) Q:'JJ I $S('$D(^PSI(58.1,JJ,"I")):0,'^("I"):0,^("I")>DT:0,1:1) K AOULP(JJ)
G:SEL="I" START
ASKAOU F JJ=0:0 S DIC="^PSI(58.1,",DIC(0)="QEAM",DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,^(""I"")>DT:1,1:0)" D ^DIC K DIC Q:Y<0 S AOULP(+Y)=""
I '$D(AOULP)&(X'="^ALL") G END
I X="^ALL" F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU I $S('$D(^PSI(58.1,AOU,"I")):1,'^("I"):1,^("I")>DT:1,1:0) S AOULP(AOU)=""
START G:'$D(AOULP) END W !!,"You may print by either of these sorting methods:",!?5,"(1) By TYPE/LOCATION/ITEM",!?5,"(2) Alphabetical by ITEM"
SRTBY W !!,"Select SORT ORDER for report (enter 1 or 2): " R ANS:DTIME S:'$T ANS="^" G:"^"[ANS END
I ANS'=1&(ANS'=2) W *7,!!,"Enter ""1"" if you wish to print the AOU stock list sorted",!,"by type, and within type by location.",!,"Enter ""2"" to print the AOU stock list alphabetically." G SRTBY
W !!,"The right margin for this report is 132.",!,"You may queue the report to print at a later time.",!!
DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
I $D(IO("Q")) K IO("Q") S ZTRTN=$S(ANS=1:"ENQ^PSGWLSI1",1:"ENQ^PSGWLSI2"),ZTDESC="List Stock Items" S:$D(AOULP) ZTSAVE("AOULP(")="" F G="AOU","ANS","SEL","IGDA" S:$D(@G) ZTSAVE(G)=""
I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
U IO G:ANS=1 ENQ^PSGWLSI1 G:ANS=2 ENQ^PSGWLSI2
;
END K JJ,X,Y,ZTSK,AOU,AOULP,ANS,G,SEL,IGDA,IO("Q")
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWLSI 1635 printed Nov 22, 2024@16:49:45 Page 2
PSGWLSI ;BHAM ISC/PTD,CML-List Active Stock Items for AOU(s) ; 05/25/90 8:50
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 DO SEL^PSGWUTL1
if '$DATA(SEL)
GOTO END
IF SEL="I"
FOR JJ=0:0
SET JJ=$ORDER(AOULP(JJ))
if 'JJ
QUIT
IF $SELECT('$DATA(^PSI(58.1,JJ,"I")):0,'^("I"):0,^("I")>DT:0,1:1)
KILL AOULP(JJ)
+3 if SEL="I"
GOTO START
ASKAOU FOR JJ=0:0
SET DIC="^PSI(58.1,"
SET DIC(0)="QEAM"
SET DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,^(""I"")>DT:1,1:0)"
DO ^DIC
KILL DIC
if Y<0
QUIT
SET AOULP(+Y)=""
+1 IF '$DATA(AOULP)&(X'="^ALL")
GOTO END
+2 IF X="^ALL"
FOR AOU=0:0
SET AOU=$ORDER(^PSI(58.1,AOU))
if 'AOU
QUIT
IF $SELECT('$DATA(^PSI(58.1,AOU,"I")):1,'^("I"):1,^("I")>DT:1,1:0)
SET AOULP(AOU)=""
START if '$DATA(AOULP)
GOTO END
WRITE !!,"You may print by either of these sorting methods:",!?5,"(1) By TYPE/LOCATION/ITEM",!?5,"(2) Alphabetical by ITEM"
SRTBY WRITE !!,"Select SORT ORDER for report (enter 1 or 2): "
READ ANS:DTIME
if '$TEST
SET ANS="^"
if "^"[ANS
GOTO END
+1 IF ANS'=1&(ANS'=2)
WRITE *7,!!,"Enter ""1"" if you wish to print the AOU stock list sorted",!,"by type, and within type by location.",!,"Enter ""2"" to print the AOU stock list alphabetically."
GOTO SRTBY
+2 WRITE !!,"The right margin for this report is 132.",!,"You may queue the report to print at a later time.",!!
DEV KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
GOTO END
+1 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN=$SELECT(ANS=1:"ENQ^PSGWLSI1",1:"ENQ^PSGWLSI2")
SET ZTDESC="List Stock Items"
if $DATA(AOULP)
SET ZTSAVE("AOULP(")=""
FOR G="AOU","ANS","SEL","IGDA"
if $DATA(@G)
SET ZTSAVE(G)=""
+2 IF $TEST
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
GOTO END
+3 USE IO
if ANS=1
GOTO ENQ^PSGWLSI1
if ANS=2
GOTO ENQ^PSGWLSI2
+4 ;
END KILL JJ,X,Y,ZTSK,AOU,AOULP,ANS,G,SEL,IGDA,IO("Q")
+1 DO ^%ZISC
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
