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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSDELT 1749 printed Apr 09, 2024@21:23:23 Page 2
QAOSDELT ;HISC/DAD-PURGE DELETED OCCURRENCES ;9/14/93 11:37
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 WRITE !!!?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 ;
+1 WRITE !!,"Are you sure you want to continue"
SET %=2
DO YN^DICN
+2 if (%=-1)!(%=2)
GOTO EXIT
IF '%
WRITE !!?5,"Please answer Y(es) or N(o)"
GOTO ASK
SCRN ;
+1 WRITE !!,"Select the screens to purge."
KILL ^UTILITY($JOB,"QAOSDELT")
+2 SET QAQDIC="^QA(741.1,"
SET QAQDIC(0)="AEMNQZ"
SET QAQDIC("A")="Select SCREEN: "
+3 SET QAQDIC("B")="ALL"
SET QAQUTIL="QAOSDELT"
DO ^QAQSELCT
if QAQQUIT
GOTO EXIT
DATE ;
+1 WRITE !!,"Select the date range to purge."
+2 DO ^QAQDATE
if QAQQUIT
GOTO EXIT
IF QAQNBEG>DT
WRITE !?5,"*** Beginning date must be today or earlier !! ***",*7
GOTO DATE
+3 SET ZTRTN="ENTSK^QAOSDELT"
SET ZTDTH=$HOROLOG
+4 SET (ZTIO,ZTSAVE("QAQ*"),ZTSAVE("QAO*"),ZTSAVE("^UTILITY($J,"))=""
+5 SET ZTDESC="Purge deleted occurrence screen records"
+6 DO ^%ZTLOAD
WRITE !!,"Deletion request queued."
+7 GOTO EXIT
ENTSK ;
+1 KILL QAOSTEST
FOR QA=0:0
SET QA=$ORDER(^DD(741,.01,"DEL",QA))
if QA'>0
QUIT
Begin DoDot:1
+2 SET X=$GET(^DD(741,.01,"DEL",QA,0))
+3 if X]""
SET QAOSTEST(QA)=X
+4 QUIT
End DoDot:1
+5 FOR QAOSDT=QAQNBEG-.0000001:0
SET QAOSDT=$ORDER(^QA(741,"C",QAOSDT))
if (QAOSDT'>0)!(QAOSDT>QAQNEND)!(QAOSDT\1'?7N)
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741,"C",QAOSDT,QAOSD0))
if QAOSD0'>0
QUIT
Begin DoDot:1
+6 SET QAOSZERO=$GET(^QA(741,QAOSD0,0))
if $PIECE(QAOSZERO,"^",11)'=2
QUIT
+7 SET QAOSSCRN=+$GET(^QA(741,QAOSD0,"SCRN"))
+8 if $DATA(^UTILITY($JOB,"QAOSDELT",QAOSSCRN,QAOSSCRN))[0
QUIT
+9 SET QAOSTEST=0
FOR QA=0:0
SET QA=$ORDER(QAOSTEST(QA))
if QA'>0!QAOSTEST
QUIT
Begin DoDot:2
+10 XECUTE QAOSTEST(QA)
SET QAOSTEST=$TEST
+11 QUIT
End DoDot:2
+12 IF 'QAOSTEST
SET DIK="^QA(741,"
SET DA=QAOSD0
DO ^DIK
+13 QUIT
End DoDot:1
EXIT ;
+1 KILL %,DA,DIK,QA,QAOSD0,QAOSDT,QAOSSCRN,QAOSTEST,QAOSZERO
+2 KILL ^UTILITY($JOB,"QAOSDELT")
+3 DO K^QAQDATE
+4 QUIT
