source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCG238Q.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PRCG238Q ;WISC/BGJ-IFCAP 410 FILE CLEANUP (QUEUE) ;11/8/99
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;This routine is installed by patch PRC*5*238.
5 ;This routine creates entries in file 443.1 for background processing
6 ;by PurgeMaster. Entries are created for files 410, 410.1 and 443.
7 ;Routine PRCG238P will be utilized by PurgeMaster to actually purge the
8 ;entries in these files.
9 ;
10 W @IOF,!
11 D MSG
12 S %A="Are you ready to continue",%A(0)="!",%=1
13 D ^PRCFYN Q:%'=1
14 S PRCF("X")="AS" D ^PRCFSITE G OUT:'%
15 D NOW^%DTC K %H,%,%I
16 S CFY=$E(X,1,3)+1700,CFY=$S(+$E(X,4,5)>9:CFY+1,1:CFY)
17 S PFY=CFY-1700-1_"0930"
18 S X="Date/Fiscal Year thru which temporary requests in file 410 will be purged."
19 D DATE
20 I +OUT G OUT
21 I $E(Y,4,7)="0000" S Y=$E(Y,1,3)_"0930"
22 S PRC("TEMPDATE")=Y
23 S PFY=CFY-1700-3_"0930"
24 S X="Date/Fiscal Year thru which entries in file 410 not associated with an entry in file 442 will be purged."
25 D DATE
26 I +OUT G OUT
27 I $E(Y,4,7)="0000" S Y=$E(Y,1,3)_"0930"
28 K OUT
29 S PRC("PERMDATE")=Y
30DQ ;
31 I $D(ZTQUEUED) S ZTREQ="@"
32 F I=1:1 S X=$T(LOAD+I) Q:$P(X,";",3)="" D
33 . S FILE(I)=$P(X,";",3),GLO(I)=$P(X,";",4),REF(I)=$P(X,";",5),ADDVAR(I)=$P(X,";",6)
34 S N=0,TREC=0
35 F S N=$O(GLO(N)) Q:'N D
36 . S X="S REC(N)=$P("_GLO(N)_"0),U,4)" X X S TREC=TREC+REC(N)
37 S OGET=TREC\1000+1
38 S MESSAGE="CREATING PURGEMASTER ENTRIES FOR FILE CLEANUP"
39 D BEGIN^PRCGU
40 S LEVEL=0
41 F S LEVEL=$O(GLO(LEVEL)) Q:LEVEL="" D
42 . S GLO=GLO(LEVEL),REF=REF(LEVEL),ADDVAR=""
43 . S:ADDVAR(LEVEL)]"" @("ADDVAR="_ADDVAR(LEVEL))
44 . S NEXT=0
45 . F D S XCOUNT=XCOUNT+COUNT D PERCENT^PRCGU Q:'NEXT
46 . . S COUNT=0
47 . . F D Q:'NEXT!(COUNT>LREC)
48 . . . S GET=($S((LREC-COUNT)>OGET:OGET,1:(LREC-COUNT)+2))-1
49 . . . I GET<1 S GET=1
50 . . . D GET
51 . . . Q:'NEXT
52 . . . S COUNT=COUNT+ICOUNT
53 . . . S Z="",ROUTINE=REF_"^PRCG238P",VARIABLE=BEGDA_"-"_ENDA_";"_PRC("SITE")
54 . . . I ADDVAR]"" S VARIABLE=VARIABLE_";"_ADDVAR
55 . . . D ADD^PRCGPM1(ROUTINE,VARIABLE,.Z)
56 D END^PRCGU
57 ;
58OUT ;
59 K A,ADDVAR,ATERM,BEGDA,BTIME,CFY,COUNT,CURSOR,DX,DY,ENDA,FILE,GET,GLO,HOURS,ICOUNT,LEVEL,LINE,LREC,MIN,NEXT,OGET,OUT,PERCENT,PFY,REC,REF,ROUTINE,RTIME,SEC,TIME,TREC,TTIME,VARIABLE,X,XCOUNT,XPOS,Y,Z,PRC
60 D KILL^%ZISS
61 Q
62GET ;
63 S (BEGDA,ENDA)=NEXT+1,ICOUNT=1
64 S @("NEXT=$O("_GLO_"NEXT))")
65 I 'NEXT S NEXT="" Q
66 S BEGDA=NEXT,(NEXT,ENDA)=NEXT+GET,ICOUNT=ENDA-BEGDA+1
67 Q
68MSG ;
69 S X="This will schedule records in files 410, 410.1 and 443 for review "
70 S X=X_"in the background by PurgeMaster (file 443.1 will be populated). "
71 S X=X_"Entries in file 410 will be purged first by PurgeMaster based "
72 S X=X_"on dates that you will enter. As data in file 410 is purged, "
73 S X=X_"related entries in file 410.1 are also purged. Entries in file "
74 S X=X_"443 will be purged next if there is no corresponding entry in "
75 S X=X_"file 410. Finally, additional clean-up will be performed on file 410.1."
76 D MSG^PRCFQ
77 W ! S X="The dates you are about to enter MUST be confirmed with A&MM "
78 S X=X_"or Fiscal staff. FAILURE TO DO SO MAY RESULT IN DATA "
79 S X=X_"CORRUPTION." D MSG^PRCFQ W $C(7),$C(7),$C(7)
80 Q
81DATE ;Select fiscal year
82 S DIR(0)="DA^:"_PFY_":EA"
83 S DIR("A")="Select DATE/FISCAL YEAR: "
84 S DIR("A",1)=X
85 S DIR("?")="You may only select for purging those documents which are not in the current Fiscal Year."
86 S DIR("?",1)="This MUST be the same date/fiscal year you entered in the Find Archivable IFCAP Records [PRCG ARCHIVE FIND] menu option during your last archive/purge."
87 D ^DIR
88 S OUT=$G(DTOUT)_$G(DUOUT)_$G(DIRUT)_$G(DIROUT)
89 K DTOUT,DUOUT,DIRUT,DIROUT,DIR
90 Q
91LOAD ;
92 ;;410;^PRCS(410,;410;PRC("TEMPDATE")_"-"_PRC("PERMDATE")
93 ;;443;^PRC(443,;443
94 ;;410.1;^PRCS(410.1,;4101;"-"_PRC("PERMDATE")
95 ;;;
Note: See TracBrowser for help on using the repository browser.