source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSDELT.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: 1.7 KB
Line 
1QAOSDELT ;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
4ASK ;
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
7SCRN ;
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
11DATE ;
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
19ENTSK ;
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
33EXIT ;
34 K %,DA,DIK,QA,QAOSD0,QAOSDT,QAOSSCRN,QAOSTEST,QAOSZERO
35 K ^UTILITY($J,"QAOSDELT")
36 D K^QAQDATE
37 Q
Note: See TracBrowser for help on using the repository browser.