| 1 | GECSPURG ;WISC/RFJ/KLD-purge code sheets (ask prompts) ;01 Nov 93
|
|---|
| 2 | ;;2.0;GCS;**23**;MAR 14, 1995
|
|---|
| 3 | W !,"This routine will delete Code Sheets from the Code Sheet file and"
|
|---|
| 4 | W !,"Batch and Transmission records from the Transmission Record file."
|
|---|
| 5 | W !,"Deletion is based upon the date a batch and a code sheet is"
|
|---|
| 6 | W !,"created.",!
|
|---|
| 7 | N %,%H,%I,DIR,DONTASK,GECS,GECSDATE,GECSDT,GECSDTST,X,Y
|
|---|
| 8 | D ^GECSSITE Q:'$G(GECS("SITE"))
|
|---|
| 9 | ;
|
|---|
| 10 | ; if programmer, ask to purge *all* code sheets
|
|---|
| 11 | I '$L($G(GECSSYS)),$G(DUZ(0))="@" N GECSSYS D ALL Q:GECSSYS="^" I GECSSYS="*" D ASK Q
|
|---|
| 12 | ;
|
|---|
| 13 | I $L($G(GECSSYS)) S DONTASK=1
|
|---|
| 14 | W ! D BATTYPE^GECSUSEL($G(GECSSYS),$G(DONTASK)) Q:'$G(GECS("BATDA"))
|
|---|
| 15 | N GECSSYS
|
|---|
| 16 | S GECSSYS=GECS("BATCH")
|
|---|
| 17 | ;
|
|---|
| 18 | ASK ; ask days to retain code sheets
|
|---|
| 19 | S DIR(0)="NO^0:999999:0",DIR("A")="Enter the number of days you wish to retain code sheets",DIR("B")=365
|
|---|
| 20 | S DIR("?",1)="Enter the number of days you want to retain code sheets. Code sheet created",DIR("?")="past the retaining days will be deleted."
|
|---|
| 21 | W ! D ^DIR I Y'>0 Q
|
|---|
| 22 | S GECSDT=Y
|
|---|
| 23 | I Y<30 W !!,"NOTICE: I recommend keeping code sheets for at least 30 days."
|
|---|
| 24 | ;
|
|---|
| 25 | I GECSSYS="*"!($G(GECS("SYSID"))="FMS") D
|
|---|
| 26 | . S X1=DT,X2=-365 D C^%DTC S (Y,GECSDTST)=X D DD^%DT
|
|---|
| 27 | . W !!,"This program will remove all stack file entries which were created before",!,Y,"."
|
|---|
| 28 | ;
|
|---|
| 29 | ; calculate cutoff date
|
|---|
| 30 | S X1=DT,X2=-GECSDT D C^%DTC S (Y,GECSDT)=X D DD^%DT S GECSDATE=Y
|
|---|
| 31 | S XP="I will now delete all code sheets and associated records which were"
|
|---|
| 32 | S XP(1)="created before "_GECSDATE_" for station "_GECS("SITE")_GECS("SITE1")_".",XP(2)="OK to continue"
|
|---|
| 33 | W ! I $$YN^GECSUTIL(1)'=1 Q
|
|---|
| 34 | ;
|
|---|
| 35 | S %ZIS="Q" W ! D ^%ZIS Q:POP
|
|---|
| 36 | I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^GECSPUR1",ZTDESC="Purge Generic Code Sheets",ZTSAVE("GECS*")="",ZTSAVE("ZTREQ")="@" D ^%ZTLOAD K ZTSK Q
|
|---|
| 37 | W !!,">> please wait <<"
|
|---|
| 38 | D DQ^GECSPUR1
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | ;
|
|---|
| 42 | ALL ; ask to delete all code sheets
|
|---|
| 43 | S XP="DO YOU WANT TO DELETE ALL TYPES OF CODE SHEETS",XH="ENTER 'YES' TO DELETE ALL TYPE OF CODE SHEETS, 'NO' TO SELECT THE BATCH TYPE."
|
|---|
| 44 | W ! S %=$$YN^GECSUTIL(2)
|
|---|
| 45 | I %=2 S GECSSYS="" Q
|
|---|
| 46 | I %=1 S GECSSYS="*" Q
|
|---|
| 47 | S GECSSYS="^"
|
|---|
| 48 | Q
|
|---|
