| [613] | 1 | QAOSDELT ;HISC/DAD-PURGE DELETED OCCURRENCES ;9/14/93 11:37
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | 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
|
|---|
| 4 | ASK ;
|
|---|
| 5 | W !!,"Are you sure you want to continue" S %=2 D YN^DICN
|
|---|
| 6 | G:(%=-1)!(%=2) EXIT I '% W !!?5,"Please answer Y(es) or N(o)" G ASK
|
|---|
| 7 | SCRN ;
|
|---|
| 8 | W !!,"Select the screens to purge." K ^UTILITY($J,"QAOSDELT")
|
|---|
| 9 | S QAQDIC="^QA(741.1,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select SCREEN: "
|
|---|
| 10 | S QAQDIC("B")="ALL",QAQUTIL="QAOSDELT" D ^QAQSELCT G:QAQQUIT EXIT
|
|---|
| 11 | DATE ;
|
|---|
| 12 | W !!,"Select the date range to purge."
|
|---|
| 13 | D ^QAQDATE G:QAQQUIT EXIT I QAQNBEG>DT W !?5,"*** Beginning date must be today or earlier !! ***",*7 G DATE
|
|---|
| 14 | S ZTRTN="ENTSK^QAOSDELT",ZTDTH=$H
|
|---|
| 15 | S (ZTIO,ZTSAVE("QAQ*"),ZTSAVE("QAO*"),ZTSAVE("^UTILITY($J,"))=""
|
|---|
| 16 | S ZTDESC="Purge deleted occurrence screen records"
|
|---|
| 17 | D ^%ZTLOAD W !!,"Deletion request queued."
|
|---|
| 18 | G EXIT
|
|---|
| 19 | ENTSK ;
|
|---|
| 20 | K QAOSTEST F QA=0:0 S QA=$O(^DD(741,.01,"DEL",QA)) Q:QA'>0 D
|
|---|
| 21 | . S X=$G(^DD(741,.01,"DEL",QA,0))
|
|---|
| 22 | . S:X]"" QAOSTEST(QA)=X
|
|---|
| 23 | . Q
|
|---|
| 24 | 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
|
|---|
| 25 | . S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:$P(QAOSZERO,"^",11)'=2
|
|---|
| 26 | . S QAOSSCRN=+$G(^QA(741,QAOSD0,"SCRN"))
|
|---|
| 27 | . Q:$D(^UTILITY($J,"QAOSDELT",QAOSSCRN,QAOSSCRN))[0
|
|---|
| 28 | . S QAOSTEST=0 F QA=0:0 S QA=$O(QAOSTEST(QA)) Q:QA'>0!QAOSTEST D
|
|---|
| 29 | .. X QAOSTEST(QA) S QAOSTEST=$T
|
|---|
| 30 | .. Q
|
|---|
| 31 | . I 'QAOSTEST S DIK="^QA(741,",DA=QAOSD0 D ^DIK
|
|---|
| 32 | . Q
|
|---|
| 33 | EXIT ;
|
|---|
| 34 | K %,DA,DIK,QA,QAOSD0,QAOSDT,QAOSSCRN,QAOSTEST,QAOSZERO
|
|---|
| 35 | K ^UTILITY($J,"QAOSDELT")
|
|---|
| 36 | D K^QAQDATE
|
|---|
| 37 | Q
|
|---|
