- 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 Apr 23, 2025@17:53:59 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
