PSGWAOUI.m

PSGWAOUI ;BHAM ISC/CML-Enter/Edit AOU Inactivation Dates ; 21 Aug 96 / 2:37 PM

 ;;2.3; Automatic Replenishment/Ward Stock ;**7,8**;4 JAN 94

 W !!,"Enter AOU Inactivation Dates" S QFLG=0

 K DIC F Q=0:0 S DIC="^PSI(58.1,",DIC(0)="QEAM" W ! D ^DIC K DIC Q:Y'>0  S (DA,AOU)=+Y,PRE="" S:$D(^PSI(58.1,DA,"I")) PRE=^("I") S DIE="^PSI(58.1,",DR="3" W ! D ^DIE Q:$D(Y)  D CHK Q:QFLG

QUIT K %,%DT,%Y,AOU,ASKFLG,C,D0,DA,DI,DIE,DIC,DIYS,DQ,DR,FOUND,INDT,ITM,JJ,POST,PRE,PRTDT,Q,QFLG,X,Y Q

CHK ; Do checks on AOU inactivation date

 S POST="" I $D(^PSI(58.1,AOU,"I")) S POST=^("I") Q:PRE=""&(POST="")

 I PRE=POST!(PRE=""&(POST]"")) W !,"...One moment, please..." D ITMCHK D:ASKFLG ASK Q

 I PRE]""&(POST="") D REACT Q

 I PRE'=POST W !,"...Hmm, one moment..." D ITMCHK D:ASKFLG ASK

 Q

ITMCHK ; Look for any currently active items or items with an inactive date AFTER TODAY

 S ASKFLG=0 F ITM=0:0 S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:'ITM  I $P(^PSI(58.1,AOU,1,ITM,0),"^",3)=""!($P(^(0),"^",3)>DT) S ASKFLG=1 Q

 Q

ASK ; Ask if currently active items are to be inactivated

 S INDT=POST S Y=INDT X ^DD("DD") S PRTDT=Y W !!,"There are items in this AOU that are currently active.",!,"You may, at this time, inactivate all of them as of ",Y,"."

 F JJ=0:0 W !!,"Do you want to do this" S %=1 D YN^DICN Q:%  D HELP

 D:%=1 INACT S:%<0 QFLG=1 Q

INACT ; Inactivate items

 S DA(1)=AOU,DIE="^PSI(58.1,"_DA(1)_",1,",DR="30///"_$P(PRTDT,"@")_";31///O;33///AOU INACTIVATED" W !!,"Now inactivating all currently active items as of ",PRTDT

 F ITM=0:0 S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:'ITM  I $D(^PSI(58.1,AOU,1,ITM,0)) I $P(^(0),"^",3)=""!($P(^(0),"^",3)>DT) S DA=ITM D ^DIE W "."

 Q

REACT ; Reactivate items

 S DA(1)=AOU,DIE="^PSI(58.1,"_DA(1)_",1,",DR="30///@" W !!,"Now deleting the inactivation dates for any items that were inactivated when",!,"this AOU was inactivated" S FOUND=0

 F ITM=0:0 S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:'ITM  I $D(^PSI(58.1,AOU,1,ITM,0)),$P(^(0),"^",9)="AOU INACTIVATED" S DA=ITM D ^DIE W "." S FOUND=1

 I 'FOUND W *7,"   ...None found!"

 Q

HELP ;

 W !!?5,"Enter 'Y' if you want to inactivate all currently active items.",!?5,"Enter 'N' if you do not wish to inactivate all currently active items.",!?5,"Enter ""^"" to Exit." Q

PSGWAOUI  ;BHAM ISC/CML-Enter/Edit AOU Inactivation Dates ; 21 Aug 96 / 2:37 PM

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;**7,8**;4 JAN 94

 +2        WRITE !!,"Enter AOU Inactivation Dates"

           SET QFLG=0

 +3        KILL DIC

           FOR Q=0:0

               SET DIC="^PSI(58.1,"

               SET DIC(0)="QEAM"

               WRITE !

               DO ^DIC

               KILL DIC

               IF Y'>0

                   QUIT 

               SET (DA,AOU)=+Y

               SET PRE=""

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

                   SET PRE=^("I")

               SET DIE="^PSI(58.1,"

               SET DR="3"

               WRITE !

               DO ^DIE

               IF $DATA(Y)

                   QUIT 

               DO CHK

               IF QFLG

                   QUIT 

QUIT       KILL %,%DT,%Y,AOU,ASKFLG,C,D0,DA,DI,DIE,DIC,DIYS,DQ,DR,FOUND,INDT,ITM,JJ,POST,PRE,PRTDT,Q,QFLG,X,Y

           QUIT 

CHK       ; Do checks on AOU inactivation date

 +1        SET POST=""

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

               SET POST=^("I")

               IF PRE=""&(POST="")

                   QUIT 

 +2        IF PRE=POST!(PRE=""&(POST]""))

               WRITE !,"...One moment, please..."

               DO ITMCHK

               IF ASKFLG

                   DO ASK

               QUIT 

 +3        IF PRE]""&(POST="")

               DO REACT

               QUIT 

 +4        IF PRE'=POST

               WRITE !,"...Hmm, one moment..."

               DO ITMCHK

               IF ASKFLG

                   DO ASK

 +5        QUIT 

ITMCHK    ; Look for any currently active items or items with an inactive date AFTER TODAY

 +1        SET ASKFLG=0

           FOR ITM=0:0

               SET ITM=$ORDER(^PSI(58.1,AOU,1,ITM))

               IF 'ITM

                   QUIT 

               IF $PIECE(^PSI(58.1,AOU,1,ITM,0),"^",3)=""!($PIECE(^(0),"^",3)>DT)

                   SET ASKFLG=1

                   QUIT 

 +2        QUIT 

ASK       ; Ask if currently active items are to be inactivated

 +1        SET INDT=POST

           SET Y=INDT

           XECUTE ^DD("DD")

           SET PRTDT=Y

           WRITE !!,"There are items in this AOU that are currently active.",!,"You may, at this time, inactivate all of them as of ",Y,"."

 +2        FOR JJ=0:0

               WRITE !!,"Do you want to do this"

               SET %=1

               DO YN^DICN

               IF %

                   QUIT 

               DO HELP

 +3        IF %=1

               DO INACT

           IF %<0

               SET QFLG=1

           QUIT 

INACT     ; Inactivate items

 +1        SET DA(1)=AOU

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

           SET DR="30///"_$PIECE(PRTDT,"@")_";31///O;33///AOU INACTIVATED"

           WRITE !!,"Now inactivating all currently active items as of ",PRTDT

 +2        FOR ITM=0:0

               SET ITM=$ORDER(^PSI(58.1,AOU,1,ITM))

               IF 'ITM

                   QUIT 

               IF $DATA(^PSI(58.1,AOU,1,ITM,0))

                   IF $PIECE(^(0),"^",3)=""!($PIECE(^(0),"^",3)>DT)

                       SET DA=ITM

                       DO ^DIE

                       WRITE "."

 +3        QUIT 

REACT     ; Reactivate items

 +1        SET DA(1)=AOU

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

           SET DR="30///@"

           WRITE !!,"Now deleting the inactivation dates for any items that were inactivated when",!,"this AOU was inactivated"

           SET FOUND=0

 +2        FOR ITM=0:0

               SET ITM=$ORDER(^PSI(58.1,AOU,1,ITM))

               IF 'ITM

                   QUIT 

               IF $DATA(^PSI(58.1,AOU,1,ITM,0))

                   IF $PIECE(^(0),"^",9)="AOU INACTIVATED"

                       SET DA=ITM

                       DO ^DIE

                       WRITE "."

                       SET FOUND=1

 +3        IF 'FOUND

               WRITE *7,"   ...None found!"

 +4        QUIT 

HELP      ;

 +1        WRITE !!?5,"Enter 'Y' if you want to inactivate all currently active items.",!?5,"Enter 'N' if you do not wish to inactivate all currently active items.",!?5,"Enter ""^"" to Exit."

           QUIT