AZXRBUG2 ;BUGDRUG2 Purge PROGRAM [ 09/23/94 9:52 AM ]
;Version 1
;08/20/92 JOHN H. LYNCH
;
;ALLOWS THE DATA ENTRY PERSON TO PURGE A
;RANGE OF DATA FROM THE BUGDRUG2 DATABASE.
;THE ROUTINE THAT CALLS AZXRBUG2:
;AZXRBUG, Main
;THE ROUTINES THAT AZXRBUG2 CALLS:
;DD^%DT,%DT (FILEMAN DATE CONVERSION)
;^DIK (FILEMAN DELETE ROUTINE)
;Variable List
;FLE= BUGDRUG2 (Database Global).
;%DT= Validates date input from user and converts it.
;%DT("A")= Default prompt for date conversion routine.
;FROM= Users input for starting date.
;TO= Users input for ending date.
;PURGEIT= A check variable used to make sure user wants
; to purge data.
;DIK= Global root of file to purge records from.
;DATE= Used for making sure the FROM date is included
; in date range.
;RET= Used when waiting for user, "Press return..."
;Y= Used for date conversion; date to convert.
;DA= Internal entry number current up for purging.
;YN= Users input on whether to print another report.
MAIN ;AZXRBUG2 PROGRAM CONTROL
;SET LOCAL VARIABLES
S FLE="1991012" ;BUGDRUG2 (DATABASE GLOBAL)
S %DT="AEX" ;VALIDATES DATE INPUT AND
;CONVERTS IT FOR STORAGE
; A= ASK FOR DATE INPUT
; E= ECHO ANSWER
; X= EXACT DATE REQUIRED
D RANGE ;GET DATE RANGE TO PURGE
D CONT ;CONTINUE WITH PURGE?
D KILL ;KILL LOCAL VARIABLES & QUIT
Q
RANGE ;ASK USER FOR A RANGE OF DATES TO PURGE
;SET LOCAL VARIABLES
W @IOF ;CLEAR SCREEN
W !!!,"BugDrug2 Purge..."
W !!,"Enter the range of dates to purge:"
W !!,?5,"NOTE: ""From Date"" must be less than or"
W !,?12,"equal to ""To Date""."
FROM W !! ;SKIP TWO LINES
S %DT("A")=" From Date: " ;%DT("A")= DEFAULT PROMPT
D ^%DT ;CALL FILEMAN DATE CONVERSION
;TO GET THE LOWER BOUND DATE
I X="^" Q ;USER WANTS OUT / QUIT RANGE
I X="?" G FROM ;INQUIRY TO HELP; GOTO FROM
I Y=-1 W !!,*7,"Invalid Date: Press a '?' for help." G FROM
;INVALID ENTRY; GOTO FROM
S FROM=Y ;FROM= FILEMAN DATE RETURNED
; IN Y (LOWER BOUND DATE)
TO S %DT("A")=" To Date: " ;%DT("A")= DEFAULT PROMPT
D ^%DT ;CALL FILEMAN DATE CONVERSION
;TO GET THE UPPER BOUND DATE
I X="^" G FROM ;USER WANTS OUT / QUIT RANGE
I X="?" G TO ;INQUIRY TO HELP; GOTO TO
I Y=-1 W !!,*7,"Invalid Date: Press a '?' for help." G TO
;INVALID ENTRY; GOTO TO
S TO=Y ;TO= FILEMAN DATE RETURNED
; IN Y (UPPER BOUND DATE)
I FROM>TO W !!,*7,"Invalid input: ""From DATE"" must be less than or equal to ""To DATE""." R !!,"Press return to continue...",RET G RANGE
;VALID DATE INPUT:
; YES= RE-ENTER RANGE DATES
; NO= DO PURGE
H 2 D CHECK ;HANG 2 SEC. 1ST
;CHECK TO MAKE SURE USER WANTS
;TO PURGE THESE DATES
;LAST CHANCE!!!
I PURGEIT="Y" D PURGE1 ;PURGE DATA USING FROM/TO DATES
I PURGEIT="N" G RANGE ;RE-ENTER FROM/TO DATES
Q
CHECK ;GIVE USER ONE LAST CHANCE TO EXIT AND NOT PURGE
;SET LOCAL VARIABLES
S PURGEIT="N" ;PURGEIT= FLAG TO SEE IF USER
;IS SURE THEY WANT TO PURGE
;BETWEEN FROM/TO DATES
W @IOF ;CLEAR SCREEN
W !!!,"Last chance..."
S Y=FROM
D DD^%DT ;CONVERT TO EXTERNAL DATE
; VALUE RETURNED IN Y
W !!,"Date to purge from: ",Y
S Y=TO
D DD^%DT ;CONVERT TO EXTERNAL DATE
; VALUE RETURNED IN Y
W !,"Date to purge to: ",Y
SURE R !!,"Are you sure these dates are correct? N//",YN
I YN?1.3"?" W !!,"Answer with: Y= Yes, N= No" G SURE
I (YN?1"Y")!(YN?1"y")!(YN?1"YES")!(Y?1"yes") S PURGEIT="Y"
Q
PURGE1 ;PURGE ALL RECORDS WITHIN AND INCLUDING
;THE DATES INPUT BY USER (FROM/TO)
;SET LOCAL VARIABLES
S DIK="^DIZ(1991020," ;GLOBAL ROOT OF FILE (BUGDRUG2)
;TO PURGE RECORDS FROM
W @IOF ;CLEAR SCREEN
W !!,"PURGING DATA...."
S DATE=FROM-1 ;DATE= START DATE BACK ONE
; DAY TO INCLUDE THE
; 'FROM' DAY
F S DATE=$O(^DIZ(1991020,"D",DATE)) Q:DATE>TO Q:'DATE D PURGE2
;FIND ALL "D" CROSS-REFERENCES
;FOR DATE RANGE TO DELETE
;CALL PURGE2 FOR ACTUAL PURGE
W !!,"PURGE COMPLETE."
Q
PURGE2 ;FIND INTERNAL ENTRY NUMBER (DA) TO PURGE AND
;CALL FILEMAN DELETE (^DIK)
S DA=0 ;DA= INTERNAL ENTRY (DEFAULT)
F S DA=$O(^DIZ(1991020,"D",DATE,DA)) Q:'DA D ^DIK
;FIND ALL INTERNAL NUMBERS
;AND DELETE THEM THROUGH ^DIK
Q
CONT ;ASK USER WHETHER TO CONTINUE WITH PURGE
;SET LOCAL VARIABLES
R !!!!!!!,"Do you want to continue purging data? N//",YN
;ASK USER WHETHER TO CONTINUE?
I YN?1.3"?" W !!,"Answer with: Y= Yes, N= No" G CONT
;USER WANTS HELP
I (YN?1"Y")!(YN?1"y")!(YN?1"YES")!(YN?1"yes") D RANGE G CONT
Q
KILL ;KILL LOCAL VARIABLES AND EXIT ROUTINE AZXRBUG2
K FLE,%DT,FROM,TO,RET,PURGEIT,Y,DIK,DATE,DA,YN
Q
AZXRBUG2 ;BUGDRUG2 Purge PROGRAM [ 09/23/94 9:52 AM ]
+1 ;Version 1
+2 ;08/20/92 JOHN H. LYNCH
+3 ;
+4 ;ALLOWS THE DATA ENTRY PERSON TO PURGE A
+5 ;RANGE OF DATA FROM THE BUGDRUG2 DATABASE.
+6 +7 ;THE ROUTINE THAT CALLS AZXRBUG2:
+8 ;AZXRBUG, Main
+9 +10 ;THE ROUTINES THAT AZXRBUG2 CALLS:
+11 ;DD^%DT,%DT (FILEMAN DATE CONVERSION)
+12 ;^DIK (FILEMAN DELETE ROUTINE)
+13 +14 ;Variable List
+15 ;FLE= BUGDRUG2 (Database Global).
+16 ;%DT= Validates date input from user and converts it.
+17 ;%DT("A")= Default prompt for date conversion routine.
+18 ;FROM= Users input for starting date.
+19 ;TO= Users input for ending date.
+20 ;PURGEIT= A check variable used to make sure user wants
+21 ; to purge data.
+22 ;DIK= Global root of file to purge records from.
+23 ;DATE= Used for making sure the FROM date is included
+24 ; in date range.
+25 ;RET= Used when waiting for user, "Press return..."
+26 ;Y= Used for date conversion; date to convert.
+27 ;DA= Internal entry number current up for purging.
+28 ;YN= Users input on whether to print another report.
+29 MAIN ;AZXRBUG2 PROGRAM CONTROL
+1 ;SET LOCAL VARIABLES
+2 ;BUGDRUG2 (DATABASE GLOBAL)
SET FLE="1991012"
+3 ;VALIDATES DATE INPUT AND
SET %DT="AEX"
+4 ;CONVERTS IT FOR STORAGE
+5 ; A= ASK FOR DATE INPUT
+6 ; E= ECHO ANSWER
+7 ; X= EXACT DATE REQUIRED
+8 +9 ;GET DATE RANGE TO PURGE
DO RANGE
+10 ;CONTINUE WITH PURGE?
DO CONT
+11 ;KILL LOCAL VARIABLES & QUIT
DO KILL
+12 +13 QUIT
+14 RANGE ;ASK USER FOR A RANGE OF DATES TO PURGE
+1 ;SET LOCAL VARIABLES
+2 ;CLEAR SCREEN
WRITE @IOF
+3 +4 WRITE !!!,"BugDrug2 Purge..."
+5 WRITE !!,"Enter the range of dates to purge:"
+6 WRITE !!,?5,"NOTE: ""From Date"" must be less than or"
+7 WRITE !,?12,"equal to ""To Date""."
+8 FROM ;SKIP TWO LINES
WRITE !!
+1 ;%DT("A")= DEFAULT PROMPT
SET %DT("A")=" From Date: "
+2 ;CALL FILEMAN DATE CONVERSION
DO ^%DT
+3 ;TO GET THE LOWER BOUND DATE
+4 +5 ;USER WANTS OUT / QUIT RANGE
IF X="^"
QUIT
+6 ;INQUIRY TO HELP; GOTO FROM
IF X="?"
GOTO FROM
+7 IF Y=-1
WRITE !!,*7,"Invalid Date: Press a '?' for help."
GOTO FROM
+8 ;INVALID ENTRY; GOTO FROM
+9 +10 ;FROM= FILEMAN DATE RETURNED
SET FROM=Y
+11 ; IN Y (LOWER BOUND DATE)
+12 TO ;%DT("A")= DEFAULT PROMPT
SET %DT("A")=" To Date: "
+1 ;CALL FILEMAN DATE CONVERSION
DO ^%DT
+2 ;TO GET THE UPPER BOUND DATE
+3 +4 ;USER WANTS OUT / QUIT RANGE
IF X="^"
GOTO FROM
+5 ;INQUIRY TO HELP; GOTO TO
IF X="?"
GOTO TO
+6 IF Y=-1
WRITE !!,*7,"Invalid Date: Press a '?' for help."
GOTO TO
+7 ;INVALID ENTRY; GOTO TO
+8 +9 ;TO= FILEMAN DATE RETURNED
SET TO=Y
+10 ; IN Y (UPPER BOUND DATE)
+11 +12 IF FROM>TO
WRITE !!,*7,"Invalid input: ""From DATE"" must be less than or equal to ""To DATE""."
READ !!,"Press return to continue...",RET
GOTO RANGE
+13 ;VALID DATE INPUT:
+14 ; YES= RE-ENTER RANGE DATES
+15 ; NO= DO PURGE
+16 +17 ;HANG 2 SEC. 1ST
HANG 2
DO CHECK
+18 ;CHECK TO MAKE SURE USER WANTS
+19 ;TO PURGE THESE DATES
+20 ;LAST CHANCE!!!
+21 +22 ;PURGE DATA USING FROM/TO DATES
IF PURGEIT="Y"
DO PURGE1
+23 ;RE-ENTER FROM/TO DATES
IF PURGEIT="N"
GOTO RANGE
+24 QUIT
+25 CHECK ;GIVE USER ONE LAST CHANCE TO EXIT AND NOT PURGE
+1 ;SET LOCAL VARIABLES
+2 ;PURGEIT= FLAG TO SEE IF USER
SET PURGEIT="N"
+3 ;IS SURE THEY WANT TO PURGE
+4 ;BETWEEN FROM/TO DATES
+5 +6 ;CLEAR SCREEN
WRITE @IOF
+7 WRITE !!!,"Last chance..."
+8 +9 SET Y=FROM
+10 ;CONVERT TO EXTERNAL DATE
DO DD^%DT
+11 ; VALUE RETURNED IN Y
+12 WRITE !!,"Date to purge from: ",Y
+13 +14 SET Y=TO
+15 ;CONVERT TO EXTERNAL DATE
DO DD^%DT
+16 ; VALUE RETURNED IN Y
+17 WRITE !,"Date to purge to: ",Y
+18 SURE READ !!,"Are you sure these dates are correct? N//",YN
+1 +2 IF YN?1.3"?"
WRITE !!,"Answer with: Y= Yes, N= No"
GOTO SURE
+3 IF (YN?1"Y")!(YN?1"y")!(YN?1"YES")!(Y?1"yes")
SET PURGEIT="Y"
+4 QUIT
+5 PURGE1 ;PURGE ALL RECORDS WITHIN AND INCLUDING
+1 ;THE DATES INPUT BY USER (FROM/TO)
+2 ;SET LOCAL VARIABLES
+3 ;GLOBAL ROOT OF FILE (BUGDRUG2)
SET DIK="^DIZ(1991020,"
+4 ;TO PURGE RECORDS FROM
+5 +6 ;CLEAR SCREEN
WRITE @IOF
+7 WRITE !!,"PURGING DATA...."
+8 +9 ;DATE= START DATE BACK ONE
SET DATE=FROM-1
+10 ; DAY TO INCLUDE THE
+11 ; 'FROM' DAY
+12 +13 FOR
SET DATE=$ORDER(^DIZ(1991020,"D",DATE))
IF DATE>TO
QUIT
IF 'DATE
QUIT
DO PURGE2
+14 ;FIND ALL "D" CROSS-REFERENCES
+15 ;FOR DATE RANGE TO DELETE
+16 ;CALL PURGE2 FOR ACTUAL PURGE
+17 +18 WRITE !!,"PURGE COMPLETE."
+19 QUIT
+20 PURGE2 ;FIND INTERNAL ENTRY NUMBER (DA) TO PURGE AND
+1 ;CALL FILEMAN DELETE (^DIK)
+2 ;DA= INTERNAL ENTRY (DEFAULT)
SET DA=0
+3 FOR
SET DA=$ORDER(^DIZ(1991020,"D",DATE,DA))
IF 'DA
QUIT
DO ^DIK
+4 ;FIND ALL INTERNAL NUMBERS
+5 ;AND DELETE THEM THROUGH ^DIK
+6 QUIT
+7 CONT ;ASK USER WHETHER TO CONTINUE WITH PURGE
+1 ;SET LOCAL VARIABLES
+2 +3 READ !!!!!!!,"Do you want to continue purging data? N//",YN
+4 ;ASK USER WHETHER TO CONTINUE?
+5 +6 IF YN?1.3"?"
WRITE !!,"Answer with: Y= Yes, N= No"
GOTO CONT
+7 ;USER WANTS HELP
+8 IF (YN?1"Y")!(YN?1"y")!(YN?1"YES")!(YN?1"yes")
DO RANGE
GOTO CONT
+9 QUIT
+10 KILL ;KILL LOCAL VARIABLES AND EXIT ROUTINE AZXRBUG2
+1 KILL FLE,%DT,FROM,TO,RET,PURGEIT,Y,DIK,DATE,DA,YN
+2 QUIT
