PSGWLSI.m

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

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