source: FOIAVistA/trunk/r/GENERIC_CODE_SHEET-GEC/GECSPURG.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1GECSPURG ;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 ;
18ASK ; 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 ;
42ALL ; 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
Note: See TracBrowser for help on using the repository browser.