SDPURG.m

SDPURG ;ALB/TMP - Purge Routine Parameter Selection ; 12/24/85

 ;;5.3;Scheduling;**140,132,1015**;Aug 13, 1993;Build 21

 ;IHS/ANMC/LJF 12/13/2000 changed all default answers to NO

 ;

 S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL

 S SDLIM=($E(DT,1,3)-$S($E(DT,4,5)>9:1,1:2))_"1001"

 W !,"The date you select to delete through may not exceed " S X1=SDLIM,X2=-1 D C^%DTC S (Y,SDLFY)=X D DT^DIQ W "."

 W !,"The files you may choose to delete from and the nodes that will be deleted are:",!!," from the HOSPITAL LOCATION File",!,"  -  the 'S' nodes, APPOINTMENT multiple"

 W !,"  -  the 'ST' nodes, clinic PATTERN multiple",!,"  -  the 'OST' nodes, clinic SPECIAL PATTERN multiple",!,"  -  the 'C' nodes, CHART CHECK multiple",!,"  -  the 'AAS' nodes, 10/10 visits cross-reference"

 W !," from the PATIENT File",!,"  -  the 'ASDPSD' nodes, Special Survey cross-reference"

 ;W !!,"OK to continue" S %=1 D YN^DICN Q:%<0!(%>1)  I '% G SDPURG  ;IHS/ANMC/LJF 12/13/2000

 W !!,"OK to continue" S %=2 D YN^DICN Q:%<0!(%>1)  I '% G SDPURG  ;IHS/ANMC/LJF 12/13/2000

A1 S %=2 W !!,"Do you want to purge the Hospital Location file nodes" D YN^DICN Q:%<0  I '% W !,"Reply YES or NO" G A1

 S SD44=$S('(%-1):1,1:0)

A2 S %=2 W !!,"Do you want to purge the Patient file nodes" D YN^DICN Q:%<0  I '% W !,"Reply YES or NO" G A2

 S SD2=$S('(%-1):1,1:0)

 I 'SD2,'SD44 W !!,*7,"No files selected for purging --- NO PURGING DONE!!" G Q^SDPURG1

DT1 S Y=SDLFY D D^DIQ W !!,"Select date through which you want these files purged: ",Y," // " R X:DTIME Q:X["^"  I X']"" S SDLIM1=SDLIM G OV

 I X?1"?".E W !,"This date may be different from the default - choose the date through which",!," you want to purge" G DT1

 W ! S %DT="E",%DT(0)=-DT D ^%DT I Y'>0 W !,"Invalid date" G DT1

 I Y>SDLFY W !,*7,"You can only purge data up to " S Y=SDLFY D DT^DIQ G DT1

 K %DT S SDLIM1=+Y_.9

OV I 'SD2,'SD44 W !!,*7,"No files selected for purging --- NO PURGING DONE!!" G Q^SDPURG1

A4 S %=2 W !!,"Do you want to print nodes (in GLOBAL format - %G) as they are deleted" D YN^DICN Q:%<0  I '% W !,"Reply YES or NO" G A4

 S SDPR=$S('(%-1):1,1:0)

A5 ;S %=1 W !!,"Is everything OK to proceed" D YN^DICN Q:%<0  I '% W !,"Reply YES or NO" G A5  ;IHS/ANMC/LJF 12/13/2000

 S %=2 W !!,"Is everything OK to proceed" D YN^DICN Q:%<0  I '% W !,"Reply YES or NO" G A5  ;IHS/ANMC/LJF 12/13/2000

 I (%-1) W !,*7,"NO PURGING DONE!!" G Q^SDPURG1

 S VAR="SDLIM^SDLIM1^SD44^SD2^SDPR",VAL=SDLIM_"^"_SDLIM1_"^"_SD44_"^"_SD2_"^"_SDPR,PGM="START^SDPURG1" D ZIS^DGUTQ G:POP Q^SDPURG1

 G START^SDPURG1

SDPURG    ;ALB/TMP - Purge Routine Parameter Selection ; 12/24/85

 +1       ;;5.3;Scheduling;**140,132,1015**;Aug 13, 1993;Build 21

 +2       ;IHS/ANMC/LJF 12/13/2000 changed all default answers to NO

 +3       ;

 +4        IF '$DATA(DTIME)

               SET DTIME=300

           IF '$DATA(DT)

               DO DT^SDUTL

 +5        SET SDLIM=($EXTRACT(DT,1,3)-$SELECT($EXTRACT(DT,4,5)>9:1,1:2))_"1001"

 +6        WRITE !,"The date you select to delete through may not exceed "

           SET X1=SDLIM

           SET X2=-1

           DO C^%DTC

           SET (Y,SDLFY)=X

           DO DT^DIQ

           WRITE "."

 +7        WRITE !,"The files you may choose to delete from and the nodes that will be deleted are:",!!," from the HOSPITAL LOCATION File",!,"  -  the 'S' nodes, APPOINTMENT multiple"

 +8        WRITE !,"  -  the 'ST' nodes, clinic PATTERN multiple",!,"  -  the 'OST' nodes, clinic SPECIAL PATTERN multiple",!,"  -  the 'C' nodes, CHART CHECK multiple",!,"  -  the 'AAS' nodes, 10/10 visits cross-reference"

 +9        WRITE !," from the PATIENT File",!,"  -  the 'ASDPSD' nodes, Special Survey cross-reference"

 +10      ;W !!,"OK to continue" S %=1 D YN^DICN Q:%<0!(%>1)  I '% G SDPURG  ;IHS/ANMC/LJF 12/13/2000

 +11      ;IHS/ANMC/LJF 12/13/2000

           WRITE !!,"OK to continue"

           SET %=2

           DO YN^DICN

           IF %<0!(%>1)

               QUIT 

           IF '%

               GOTO SDPURG

A1         SET %=2

           WRITE !!,"Do you want to purge the Hospital Location file nodes"

           DO YN^DICN

           IF %<0

               QUIT 

           IF '%

               WRITE !,"Reply YES or NO"

               GOTO A1

 +1        SET SD44=$SELECT('(%-1):1,1:0)

A2         SET %=2

           WRITE !!,"Do you want to purge the Patient file nodes"

           DO YN^DICN

           IF %<0

               QUIT 

           IF '%

               WRITE !,"Reply YES or NO"

               GOTO A2

 +1        SET SD2=$SELECT('(%-1):1,1:0)

 +2        IF 'SD2

               IF 'SD44

                   WRITE !!,*7,"No files selected for purging --- NO PURGING DONE!!"

                   GOTO Q^SDPURG1

DT1        SET Y=SDLFY

           DO D^DIQ

           WRITE !!,"Select date through which you want these files purged: ",Y," // "

           READ X:DTIME

           IF X["^"

               QUIT 

           IF X']""

               SET SDLIM1=SDLIM

               GOTO OV

 +1        IF X?1"?".E

               WRITE !,"This date may be different from the default - choose the date through which",!," you want to purge"

               GOTO DT1

 +2        WRITE !

           SET %DT="E"

           SET %DT(0)=-DT

           DO ^%DT

           IF Y'>0

               WRITE !,"Invalid date"

               GOTO DT1

 +3        IF Y>SDLFY

               WRITE !,*7,"You can only purge data up to "

               SET Y=SDLFY

               DO DT^DIQ

               GOTO DT1

 +4        KILL %DT

           SET SDLIM1=+Y_.9

OV         IF 'SD2

               IF 'SD44

                   WRITE !!,*7,"No files selected for purging --- NO PURGING DONE!!"

                   GOTO Q^SDPURG1

A4         SET %=2

           WRITE !!,"Do you want to print nodes (in GLOBAL format - %G) as they are deleted"

           DO YN^DICN

           IF %<0

               QUIT 

           IF '%

               WRITE !,"Reply YES or NO"

               GOTO A4

 +1        SET SDPR=$SELECT('(%-1):1,1:0)

A5        ;S %=1 W !!,"Is everything OK to proceed" D YN^DICN Q:%<0  I '% W !,"Reply YES or NO" G A5  ;IHS/ANMC/LJF 12/13/2000

 +1       ;IHS/ANMC/LJF 12/13/2000

           SET %=2

           WRITE !!,"Is everything OK to proceed"

           DO YN^DICN

           IF %<0

               QUIT 

           IF '%

               WRITE !,"Reply YES or NO"

               GOTO A5

 +2        IF (%-1)

               WRITE !,*7,"NO PURGING DONE!!"

               GOTO Q^SDPURG1

 +3        SET VAR="SDLIM^SDLIM1^SD44^SD2^SDPR"

           SET VAL=SDLIM_"^"_SDLIM1_"^"_SD44_"^"_SD2_"^"_SDPR

           SET PGM="START^SDPURG1"

           DO ZIS^DGUTQ

           IF POP

               GOTO Q^SDPURG1

 +4        GOTO START^SDPURG1