DGODDEL.m

DGODDEL ;ALB/EG - PURGE DISCRETIONARY WORKLOAD ; APR 24, 1989

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 W !!,*7,"DISCRETIONARY WORKLOAD OPTIONS ARE NO LONGER AVAILABLE!",!! Q

 ;;V 4.5

EN S DGDB=0,U="^" R !,"Purge single (M)onth or (A)ll or (^ to quit): MONTH// ",DGQQ:DTIME G:'$T END S DGQQ=$S(DGQQ'="":$E(DGQQ,1,1),1:"M") I DGQQ="?" D HLP G EN

 Q:"Q^"[DGQQ  I "MA"'[DGQQ W *7 G END

 I DGQQ="A" D BG G:%=2 END W !,?1,"SITE",?10,"REPORT",?20,"MONTH/YR",?30,"RUN DATE",! D:%=1 DST

 I DGQQ="M" D STH Q:Y<0  D BG G:%=2 END W !,?1,"SITE",?10,"REPORT",?20,"MONTH/YR",?30,"RUN DATE",! S DGDT=Y D:(%=1) D0

END W:DGDB=0 !,"Nothing purged, all your data is current"

 K DGA,DGDA,DGDB,DGDT,DGDV,DGI,DGJ,DGK,DGQQ,DGREP,DIC,DIC(0),DIC("S")

 Q

DST S DGDT="" F DGA=0:0 S DGDT=$O(^VAT(408,"AE",DGDT)) Q:DGDT=""  D D0

 Q

D0 Q:$D(^VAT(408,"AD",1,DGDT))>0  S DGDV="" F DGI=0:0 S DGDV=$O(^VAT(408,"AE",DGDT,DGDV)) Q:DGDV=""  D D1

 Q

D1 S DGREP="" F DGJ=0:0 S DGREP=$O(^VAT(408,"AE",DGDT,DGDV,DGREP)) Q:DGREP=""  D D2

 Q

D2 S DGDA="" F DGK=0:0 S DGDA=$O(^VAT(408,"AE",DGDT,DGDV,DGREP,DGDA)) Q:DGDA=""  I $O(^VAT(408,"AE",DGDT,DGDV,DGREP,DGDA))'="" D D3

 Q

D3 ;does deletion using ^DIK

 W !,?1,DGDV,?10,DGREP,?20,DGDT,?30,DGDA

 S DGDB=1,DIK="^VAT(408,",DA=DGDA D ^DIK K DIK,DA W ?50,"...deleted"

 Q

STH ;select entries to purge

 S U="^",DIC="^VAT(408,",DIC(0)="AEM",D="C",DZ="?" D DQ^DICQ K DO

 S %DT="PANE",%DT("A")="Select MONTH/YEAR to PURGE: " D ^%DT

 Q:Y<0

 I (+$E(Y,6,7)>0)!($D(^VAT(408,"C",Y))=0) W !!,*7,"SELECT ENTRY FROM LIST IN MONTH/YEAR FORMAT.",!,"IF JANUARY 1988 WAS LISTED YOU WOULD ENTER 01/88",! G STH

 Q

BG S %=2 W !,"ARE YOU SURE YOU WISH TO PURGE YOUR FILE " D YN^DICN S:(%<0)!(%=2) %=2

 Q

HLP ;

 F I=0:1 Q:$F($T(HLPT+I),";;")=0  W !,$P($T(HLPT+I),";;",2)

 Q

HLPT ;;MONTHLY will allow you to select a specific MONTH/YR to purge

 ;;ALL will purge your entire file, leaving only the most recent

 ;;generation for each month.

 ;;

 ;;This option will allow you to purge entries in your file up to but

 ;;not including your most recent.  If you have generated OCT 88 in

 ;;Nov, Dec, and Jan you will have 3 entries in your file corresponding

 ;;to OCT workload.  Say you generate OCT again in Feb 89 and purge

 ;;by using this option, Nov through Jan will be purged and you will

 ;;only have the most recent run remaining.  We recommend the use of

 ;;this option to keep your files small and tidy.

 ;;

DGODDEL   ;ALB/EG - PURGE DISCRETIONARY WORKLOAD ; APR 24, 1989

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2        WRITE !!,*7,"DISCRETIONARY WORKLOAD OPTIONS ARE NO LONGER AVAILABLE!",!!

           QUIT 

 +3       ;;V 4.5

EN         SET DGDB=0

           SET U="^"

           READ !,"Purge single (M)onth or (A)ll or (^ to quit): MONTH// ",DGQQ:DTIME

           IF '$TEST

               GOTO END

           SET DGQQ=$SELECT(DGQQ'="":$EXTRACT(DGQQ,1,1),1:"M")

           IF DGQQ="?"

               DO HLP

               GOTO EN

 +1        IF "Q^"[DGQQ

               QUIT 

           IF "MA"'[DGQQ

               WRITE *7

               GOTO END

 +2        IF DGQQ="A"

               DO BG

               IF %=2

                   GOTO END

               WRITE !,?1,"SITE",?10,"REPORT",?20,"MONTH/YR",?30,"RUN DATE",!

               IF %=1

                   DO DST

 +3        IF DGQQ="M"

               DO STH

               IF Y<0

                   QUIT 

               DO BG

               IF %=2

                   GOTO END

               WRITE !,?1,"SITE",?10,"REPORT",?20,"MONTH/YR",?30,"RUN DATE",!

               SET DGDT=Y

               IF (%=1)

                   DO D0

END        IF DGDB=0

               WRITE !,"Nothing purged, all your data is current"

 +1        KILL DGA,DGDA,DGDB,DGDT,DGDV,DGI,DGJ,DGK,DGQQ,DGREP,DIC,DIC(0),DIC("S")

 +2        QUIT 

DST        SET DGDT=""

           FOR DGA=0:0

               SET DGDT=$ORDER(^VAT(408,"AE",DGDT))

               IF DGDT=""

                   QUIT 

               DO D0

 +1        QUIT 

D0         IF $DATA(^VAT(408,"AD",1,DGDT))>0

               QUIT 

           SET DGDV=""

           FOR DGI=0:0

               SET DGDV=$ORDER(^VAT(408,"AE",DGDT,DGDV))

               IF DGDV=""

                   QUIT 

               DO D1

 +1        QUIT 

D1         SET DGREP=""

           FOR DGJ=0:0

               SET DGREP=$ORDER(^VAT(408,"AE",DGDT,DGDV,DGREP))

               IF DGREP=""

                   QUIT 

               DO D2

 +1        QUIT 

D2         SET DGDA=""

           FOR DGK=0:0

               SET DGDA=$ORDER(^VAT(408,"AE",DGDT,DGDV,DGREP,DGDA))

               IF DGDA=""

                   QUIT 

               IF $ORDER(^VAT(408,"AE",DGDT,DGDV,DGREP,DGDA))'=""

                   DO D3

 +1        QUIT 

D3        ;does deletion using ^DIK

 +1        WRITE !,?1,DGDV,?10,DGREP,?20,DGDT,?30,DGDA

 +2        SET DGDB=1

           SET DIK="^VAT(408,"

           SET DA=DGDA

           DO ^DIK

           KILL DIK,DA

           WRITE ?50,"...deleted"

 +3        QUIT 

STH       ;select entries to purge

 +1        SET U="^"

           SET DIC="^VAT(408,"

           SET DIC(0)="AEM"

           SET D="C"

           SET DZ="?"

           DO DQ^DICQ

           KILL DO

 +2        SET %DT="PANE"

           SET %DT("A")="Select MONTH/YEAR to PURGE: "

           DO ^%DT

 +3        IF Y<0

               QUIT 

 +4        IF (+$EXTRACT(Y,6,7)>0)!($DATA(^VAT(408,"C",Y))=0)

               WRITE !!,*7,"SELECT ENTRY FROM LIST IN MONTH/YEAR FORMAT.",!,"IF JANUARY 1988 WAS LISTED YOU WOULD ENTER 01/88",!

               GOTO STH

 +5        QUIT 

BG         SET %=2

           WRITE !,"ARE YOU SURE YOU WISH TO PURGE YOUR FILE "

           DO YN^DICN

           IF (%<0)!(%=2)

               SET %=2

 +1        QUIT 

HLP       ;

 +1        FOR I=0:1

               IF $FIND($TEXT(HLPT+I),";;")=0

                   QUIT 

               WRITE !,$PIECE($TEXT(HLPT+I),";;",2)

 +2        QUIT 

HLPT      ;;MONTHLY will allow you to select a specific MONTH/YR to purge

 +1       ;;ALL will purge your entire file, leaving only the most recent

 +2       ;;generation for each month.

 +3       ;;

 +4       ;;This option will allow you to purge entries in your file up to but

 +5       ;;not including your most recent.  If you have generated OCT 88 in

 +6       ;;Nov, Dec, and Jan you will have 3 entries in your file corresponding

 +7       ;;to OCT workload.  Say you generate OCT again in Feb 89 and purge

 +8       ;;by using this option, Nov through Jan will be purged and you will

 +9       ;;only have the most recent run remaining.  We recommend the use of

 +10      ;;this option to keep your files small and tidy.

 +11      ;;