38 lines
1.7 KiB
Mathematica
38 lines
1.7 KiB
Mathematica
QAOSDELT ;HISC/DAD-PURGE DELETED OCCURRENCES ;9/14/93 11:37
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
W !!!?32,"*** WARNING ***",!!?5,"This option purges those Occurrence Screen records flagged as deleted",!?10,"once these records have been purged they cannot be recovered",*7
|
|
ASK ;
|
|
W !!,"Are you sure you want to continue" S %=2 D YN^DICN
|
|
G:(%=-1)!(%=2) EXIT I '% W !!?5,"Please answer Y(es) or N(o)" G ASK
|
|
SCRN ;
|
|
W !!,"Select the screens to purge." K ^UTILITY($J,"QAOSDELT")
|
|
S QAQDIC="^QA(741.1,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select SCREEN: "
|
|
S QAQDIC("B")="ALL",QAQUTIL="QAOSDELT" D ^QAQSELCT G:QAQQUIT EXIT
|
|
DATE ;
|
|
W !!,"Select the date range to purge."
|
|
D ^QAQDATE G:QAQQUIT EXIT I QAQNBEG>DT W !?5,"*** Beginning date must be today or earlier !! ***",*7 G DATE
|
|
S ZTRTN="ENTSK^QAOSDELT",ZTDTH=$H
|
|
S (ZTIO,ZTSAVE("QAQ*"),ZTSAVE("QAO*"),ZTSAVE("^UTILITY($J,"))=""
|
|
S ZTDESC="Purge deleted occurrence screen records"
|
|
D ^%ZTLOAD W !!,"Deletion request queued."
|
|
G EXIT
|
|
ENTSK ;
|
|
K QAOSTEST F QA=0:0 S QA=$O(^DD(741,.01,"DEL",QA)) Q:QA'>0 D
|
|
. S X=$G(^DD(741,.01,"DEL",QA,0))
|
|
. S:X]"" QAOSTEST(QA)=X
|
|
. Q
|
|
F QAOSDT=QAQNBEG-.0000001:0 S QAOSDT=$O(^QA(741,"C",QAOSDT)) Q:(QAOSDT'>0)!(QAOSDT>QAQNEND)!(QAOSDT\1'?7N) F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSDT,QAOSD0)) Q:QAOSD0'>0 D
|
|
. S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:$P(QAOSZERO,"^",11)'=2
|
|
. S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN"))
|
|
. Q:$D(^UTILITY($J,"QAOSDELT",QAOSSCRN,QAOSSCRN))[0
|
|
. S QAOSTEST=0 F QA=0:0 S QA=$O(QAOSTEST(QA)) Q:QA'>0!QAOSTEST D
|
|
.. X QAOSTEST(QA) S QAOSTEST=$T
|
|
.. Q
|
|
. I 'QAOSTEST S DIK="^QA(741,",DA=QAOSD0 D ^DIK
|
|
. Q
|
|
EXIT ;
|
|
K %,DA,DIK,QA,QAOSD0,QAOSDT,QAOSSCRN,QAOSTEST,QAOSZERO
|
|
K ^UTILITY($J,"QAOSDELT")
|
|
D K^QAQDATE
|
|
Q
|