source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWAOUI.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PSGWAOUI ;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
5QUIT 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
6CHK ; 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
12ITMCHK ; 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
15ASK ; 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
19INACT ; 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
23REACT ; 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
28HELP ;
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
Note: See TracBrowser for help on using the repository browser.