| 1 | PSGWAOUI ;BHAM ISC/CML-Enter/Edit AOU Inactivation Dates ; 21 Aug 96 / 2:37 PM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;**7,8**;4 JAN 94
|
|---|
| 3 | W !!,"Enter AOU Inactivation Dates" S QFLG=0
|
|---|
| 4 | 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
|
|---|
| 5 | 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
|
|---|
| 6 | CHK ; Do checks on AOU inactivation date
|
|---|
| 7 | S POST="" I $D(^PSI(58.1,AOU,"I")) S POST=^("I") Q:PRE=""&(POST="")
|
|---|
| 8 | I PRE=POST!(PRE=""&(POST]"")) W !,"...One moment, please..." D ITMCHK D:ASKFLG ASK Q
|
|---|
| 9 | I PRE]""&(POST="") D REACT Q
|
|---|
| 10 | I PRE'=POST W !,"...Hmm, one moment..." D ITMCHK D:ASKFLG ASK
|
|---|
| 11 | Q
|
|---|
| 12 | ITMCHK ; Look for any currently active items or items with an inactive date AFTER TODAY
|
|---|
| 13 | 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
|
|---|
| 14 | Q
|
|---|
| 15 | ASK ; Ask if currently active items are to be inactivated
|
|---|
| 16 | 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,"."
|
|---|
| 17 | F JJ=0:0 W !!,"Do you want to do this" S %=1 D YN^DICN Q:% D HELP
|
|---|
| 18 | D:%=1 INACT S:%<0 QFLG=1 Q
|
|---|
| 19 | INACT ; Inactivate items
|
|---|
| 20 | 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
|
|---|
| 21 | 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 "."
|
|---|
| 22 | Q
|
|---|
| 23 | REACT ; Reactivate items
|
|---|
| 24 | 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
|
|---|
| 25 | 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
|
|---|
| 26 | I 'FOUND W *7," ...None found!"
|
|---|
| 27 | Q
|
|---|
| 28 | HELP ;
|
|---|
| 29 | 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
|
|---|
