| 1 | PSGPLPRG ;BIR/CML3-PURGE PICK LISTS ;20 JUL 94 / 5:46 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**5**;16 DEC 97
|
|---|
| 3 | AP ;
|
|---|
| 4 | D ENCV^PSGSETU I $D(XQUIT) Q
|
|---|
| 5 | S ND=$P($G(^PS(59.7,1,63.5)),"^",1,3) I $P(ND,"^",2) S PSGOD=$$ENDTC^PSGMI($P(ND,"^",2))
|
|---|
| 6 | W !!?$S('$P(ND,"^",2):24,ND:13,1:17),"** AUTO PURGE ",$S(ND=""!(ND="^^"):"NEVER STARTED.",ND:"SET TO "_+ND_" DAYS",1:"STOPPED") W:$P(ND,"^",2) ", AS OF ",PSGOD W " **",!
|
|---|
| 7 | ;
|
|---|
| 8 | DA ;
|
|---|
| 9 | S Y=-1,%DT="EPTX" F R !!,"Enter PURGE STOP DATE: ",X:DTIME W:'$T $C(7) S:'$T X="^" D DAM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) W:Y'>0 !,$C(7),"No date selected for purge run." Q
|
|---|
| 10 | K %DT I Y>0 S PSGPLPD=Y K ZTSAVE S PSGTID=$H,PSGTIR="ENQ^PSGPLPRG",ZTSAVE("PSGPLPD")="",ZTDESC="PICK LIST PURGE",ZTIO="" D ENNOIO^PSGTI W:$D(ZTSK) !,"Pick list purge queued!"
|
|---|
| 11 | G DONE
|
|---|
| 12 | ;
|
|---|
| 13 | DAM ;
|
|---|
| 14 | W !!," If a date is entered here, all of the FILED AWAY PICK LISTS that started ",!,"before the entered date will be deleted." Q
|
|---|
| 15 | ;
|
|---|
| 16 | ENQ ;
|
|---|
| 17 | F Q=0:0 S Q=$O(^PS(53.5,"AO",Q)) Q:'Q D
|
|---|
| 18 | .F QQ=0:0 S QQ=$O(^PS(53.5,"AO",Q,QQ)) Q:'QQ!(QQ>PSGPLPD) D
|
|---|
| 19 | ..F PLN=0:0 S PLN=$O(^PS(53.5,"AO",Q,QQ,PLN)) Q:'PLN D
|
|---|
| 20 | ...K DA,DIK S DIK="^PS(53.5,",DA=PLN D ^DIK K ^PS(53.5,PLN)
|
|---|
| 21 | ...I $D(^PS(53.55,PLN)) K DA,DIK S DIK="^PS(53.55,",DA=PLN D ^DIK K ^PS(53.55,PLN)
|
|---|
| 22 | ;
|
|---|
| 23 | DONE ;
|
|---|
| 24 | D ENKV^PSGSETU K AM,ND,PLN,PSGPLPD,ST Q
|
|---|
| 25 | ;
|
|---|
| 26 | ENASK ; sets, resets, or deletes auto purge (# of days)
|
|---|
| 27 | D ENCV^PSGSETU I $D(XQUIT) Q
|
|---|
| 28 | D NOW^%DTC S PSGDT=% S ND=$P($G(^PS(59.7,1,63.5)),"^",1,3)
|
|---|
| 29 | F W !!,"DAYS 'FILED AWAY' PICK LISTS SHOULD LAST",$S(+ND:" "_+ND_"// ",1:": ") R X:DTIME Q:"^"[X!(X?1.2N&(X>0)&(X<91)) D QUES:X?1."?",KILL:X="@" Q:X="@" W:X'?1."?" $C(7)," ??"
|
|---|
| 30 | I X,X'=+ND W:'ND " (AUTO PURGE WILL ",$P("^RE","^",ND]""+1),"START.)" S $P(^PS(59.7,1,63.5),"^",1,3)=X_"^"_PSGDT_"^"_DUZ
|
|---|
| 31 | G DONE
|
|---|
| 32 | ;
|
|---|
| 33 | QUES ;
|
|---|
| 34 | W !!," If a number is found in this field by the daily background job, the job will completely delete all PICK LISTS that have been FILED AWAY and have been around longer than the number of days specified in this field."
|
|---|
| 35 | W " Entering a number into",!,"this field will effectively start the AUTO PURGE. DELETING this field will",!,"effectively STOP the AUTO PURGE."
|
|---|
| 36 | W !?3,"ENTER THE NUMBER (1-90) OF DAYS THAT PICK LISTS THAT ARE FILED AWAY MAY STAY IN THE COMPUTER." Q
|
|---|
| 37 | ;
|
|---|
| 38 | KILL ;
|
|---|
| 39 | I 'ND W " NOTHING TO DELETE!" S X="" Q
|
|---|
| 40 | W !?5,"OK TO DELETE" S %=0 D YN^DICN I %=1 S ^PS(59.7,1,63.5)="^"_PSGDT_"^"_DUZ W " DELETED! (AUTO PURGE STOPPED.)" Q
|
|---|
| 41 | W $C(7)," <NOTHING DELETED>" S X="" Q
|
|---|
