PSGWUTL1.m

PSGWUTL1 ;BHAM ISC/CML-Utility routine for HELP functions ; 15 Aug 93 / 4:46 PM

 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

SS ; Scroll-stop for last page of 80 column reports

 R !!,"END OF REPORT!  Press <RETURN> to return to Menu:",SS:DTIME K SS Q

HELP ; Help for scroll-stop

 W *7,!,"Please Enter: <RETURN> to continue viewing report or ""^"" to Exit report: "

 R ANS:DTIME S:'$T ANS="^" G:ANS?1."?" HELP Q

 ;***********************************************************************

IG ; Reset Sort Keys for inventory groups

 F INVGRP=0:0 S INVGRP=$O(^PSI(58.2,INVGRP)) Q:'INVGRP  I $O(^PSI(58.2,INVGRP,1,"D",0)) W "." D IGSET

 K INVGRP Q

IGSET S CNT=0 F SK=0:0 S SK=$O(^PSI(58.2,INVGRP,1,"D",SK)) Q:'SK  S AOU=$O(^PSI(58.2,INVGRP,1,"D",SK,0)),CNT=CNT+1,AOULP(CNT)=AOU

 F SK=0:0 S SK=$O(AOULP(SK)) Q:'SK  S NSK=SK*100,DA(1)=INVGRP,DA=AOULP(SK),DIE="^PSI(58.2,"_DA(1)_",1,",DR="2///"_NSK D ^DIE

 K D,D0,DA,DI,DIC,DIE,DQ,DR,X,CNT,SK,NSK,AOU,AOULP Q

 ;***********************************************************************

SEL ; Ask if reports are to print by Inventory Group or AOU

 W !!?5,"You may select a single AOU, several AOUs,",!?5,"or enter ""^ALL"" to select all AOUs.",!?20,"-OR-",!?5,"You may select an Inventory Group."

ASKSEL ;

 W !!,"Do you want to select AOU(s) or an Inventory Group? (Enter 'A' or 'I'): " R SEL:DTIME S:'$T SEL="^" G:"^"[SEL QUIT I SEL?1."?" D HELPSEL G ASKSEL

 I SEL'="A"&(SEL'="I") W *7,"??" D HELPSEL G ASKSEL

 W !

ASKIG Q:SEL="A"  S DIC="^PSI(58.2,",DIC(0)="QEAM",DIC("S")="I $D(^PSI(58.2,""WS"",+Y))" D ^DIC K DIC I Y<0 K SEL Q

 S IGDA=+Y I '$O(^PSI(58.2,IGDA,1,0)) W *7,!!,"There are no AOUs defined for this Inventory Group!" G ASKIG

 F IGAOU=0:0 S IGAOU=$O(^PSI(58.2,IGDA,1,IGAOU)) Q:'IGAOU  S AOULP(IGAOU)=""

 W !!,"This Inventory Group contains the following AOU(s):" F IGAOU=0:0 S IGAOU=$O(AOULP(IGAOU)) Q:'IGAOU  W !?5,$P(^PSI(58.1,IGAOU,0),"^") I $D(^PSI(58.1,IGAOU,"I")),^("I"),^("I")'>DT W "   *** INACTIVE ***"

QUIT K:SEL="^"!(SEL="") SEL K %,IGAOU,DIC,X,Y Q

HELPSEL ;

 W !!?5,"Enter an 'A' if you wish to select individual AOUs (one, several or ^ALL).",!?5,"Enter an 'I' if you wish to select all AOUs in an Inventory Group.",!?5,"Or enter ""^"" to Exit." Q

PSGWDT() ;Find current date and time

 D NOW^%DTC

 S Y=$E(%,1,12)

 X ^DD("DD")

 Q Y

PSGWUTL1  ;BHAM ISC/CML-Utility routine for HELP functions ; 15 Aug 93 / 4:46 PM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94

SS        ; Scroll-stop for last page of 80 column reports

 +1        READ !!,"END OF REPORT!  Press <RETURN> to return to Menu:",SS:DTIME

           KILL SS

           QUIT 

HELP      ; Help for scroll-stop

 +1        WRITE *7,!,"Please Enter: <RETURN> to continue viewing report or ""^"" to Exit report: "

 +2        READ ANS:DTIME

           IF '$TEST

               SET ANS="^"

           IF ANS?1."?"

               GOTO HELP

           QUIT 

 +3       ;***********************************************************************

IG        ; Reset Sort Keys for inventory groups

 +1        FOR INVGRP=0:0

               SET INVGRP=$ORDER(^PSI(58.2,INVGRP))

               IF 'INVGRP

                   QUIT 

               IF $ORDER(^PSI(58.2,INVGRP,1,"D",0))

                   WRITE "."

                   DO IGSET

 +2        KILL INVGRP

           QUIT 

IGSET      SET CNT=0

           FOR SK=0:0

               SET SK=$ORDER(^PSI(58.2,INVGRP,1,"D",SK))

               IF 'SK

                   QUIT 

               SET AOU=$ORDER(^PSI(58.2,INVGRP,1,"D",SK,0))

               SET CNT=CNT+1

               SET AOULP(CNT)=AOU

 +1        FOR SK=0:0

               SET SK=$ORDER(AOULP(SK))

               IF 'SK

                   QUIT 

               SET NSK=SK*100

               SET DA(1)=INVGRP

               SET DA=AOULP(SK)

               SET DIE="^PSI(58.2,"_DA(1)_",1,"

               SET DR="2///"_NSK

               DO ^DIE

 +2        KILL D,D0,DA,DI,DIC,DIE,DQ,DR,X,CNT,SK,NSK,AOU,AOULP

           QUIT 

 +3       ;***********************************************************************

SEL       ; Ask if reports are to print by Inventory Group or AOU

 +1        WRITE !!?5,"You may select a single AOU, several AOUs,",!?5,"or enter ""^ALL"" to select all AOUs.",!?20,"-OR-",!?5,"You may select an Inventory Group."

ASKSEL    ;

 +1        WRITE !!,"Do you want to select AOU(s) or an Inventory Group? (Enter 'A' or 'I'): "

           READ SEL:DTIME

           IF '$TEST

               SET SEL="^"

           IF "^"[SEL

               GOTO QUIT

           IF SEL?1."?"

               DO HELPSEL

               GOTO ASKSEL

 +2        IF SEL'="A"&(SEL'="I")

               WRITE *7,"??"

               DO HELPSEL

               GOTO ASKSEL

 +3        WRITE !

ASKIG      IF SEL="A"

               QUIT 

           SET DIC="^PSI(58.2,"

           SET DIC(0)="QEAM"

           SET DIC("S")="I $D(^PSI(58.2,""WS"",+Y))"

           DO ^DIC

           KILL DIC

           IF Y<0

               KILL SEL

               QUIT 

 +1        SET IGDA=+Y

           IF '$ORDER(^PSI(58.2,IGDA,1,0))

               WRITE *7,!!,"There are no AOUs defined for this Inventory Group!"

               GOTO ASKIG

 +2        FOR IGAOU=0:0

               SET IGAOU=$ORDER(^PSI(58.2,IGDA,1,IGAOU))

               IF 'IGAOU

                   QUIT 

               SET AOULP(IGAOU)=""

 +3        WRITE !!,"This Inventory Group contains the following AOU(s):"

           FOR IGAOU=0:0

               SET IGAOU=$ORDER(AOULP(IGAOU))

               IF 'IGAOU

                   QUIT 

               WRITE !?5,$PIECE(^PSI(58.1,IGAOU,0),"^")

               IF $DATA(^PSI(58.1,IGAOU,"I"))

                   IF ^("I")

                       IF ^("I")'>DT

                           WRITE "   *** INACTIVE ***"

QUIT       IF SEL="^"!(SEL="")

               KILL SEL

           KILL %,IGAOU,DIC,X,Y

           QUIT 

HELPSEL   ;

 +1        WRITE !!?5,"Enter an 'A' if you wish to select individual AOUs (one, several or ^ALL).",!?5,"Enter an 'I' if you wish to select all AOUs in an Inventory Group.",!?5,"Or enter ""^"" to Exit."

           QUIT 

PSGWDT()  ;Find current date and time

 +1        DO NOW^%DTC

 +2        SET Y=$EXTRACT(%,1,12)

 +3        XECUTE ^DD("DD")

 +4        QUIT Y