| [613] | 1 | PRCGARCF ;WIRMFO@ALTOONA/CTB FIND ARCHIVABLE RECORDS ;12/10/97 9:49 AM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;ifcap archive
|
|---|
| 5 | ;SELECT STATION
|
|---|
| 6 | S PRCF("X")="AS" D ^PRCFSITE Q:'%
|
|---|
| 7 | D NOW^%DTC
|
|---|
| 8 | S CFY=$E(X,1,3)+1700,CFY=$S(+$E(X,4,5)>9:CFY+1,1:CFY)
|
|---|
| 9 | ;SELECT FISCAL YEAR
|
|---|
| 10 | F D Q:AFY>0!($D(OUT))
|
|---|
| 11 | . S DIR(0)="D^::E",DIR("A")="Select the Fiscal Year thru which this option is to run"
|
|---|
| 12 | . S DIR("?",1)="Enter a valid FileMan date. If you select an exact date, I will",DIR("?")="convert it to the last day of the FISCAL YEAR."
|
|---|
| 13 | . D ^DIR
|
|---|
| 14 | . S AFY=0
|
|---|
| 15 | . I X["^"!(X="") S X="< No action taken>*" D MSG^PRCFQ S OUT=1 QUIT
|
|---|
| 16 | . Q:Y<0
|
|---|
| 17 | . S FY=Y
|
|---|
| 18 | . I $E(FY,4,5)>9 S FY=($E(FY,1,3)+1)_"0930"
|
|---|
| 19 | . E S FY=$E(FY,1,3)_"0930"
|
|---|
| 20 | . S AFY=$E(FY,1,3)+1700
|
|---|
| 21 | . I CFY-AFY<3 S X="You may only select for archive those documents which are greater that 2 Fiscal Years old.*" D MSG^PRCFQ S AFY=0 QUIT
|
|---|
| 22 | I $D(OUT) K OUT QUIT
|
|---|
| 23 | S %=2
|
|---|
| 24 | I $O(^PRC(443.9,0)) D
|
|---|
| 25 | . F D Q:%<3
|
|---|
| 26 | . . W !! S %A="There are already records in the IFCAP Pending Archive File",%A(1)="If these are old records, they could cause duplication of the archive.",%A(2)="Do you want me to REMOVE these records before I begin"
|
|---|
| 27 | . . S %=1 D ^PRCFYN Q:%'=1
|
|---|
| 28 | . . S %A="ARE YOU SURE" D ^PRCFYN
|
|---|
| 29 | . . Q:%'=2 W !! S X="OK, Now I'm really confused. Let's do that again.*" D MSG^PRCFQ S %=3
|
|---|
| 30 | . . QUIT
|
|---|
| 31 | . QUIT
|
|---|
| 32 | QUIT:%<0
|
|---|
| 33 | S CLEANFIL=%
|
|---|
| 34 | S ZTDESC="IFCAP ARCHIVE RECORD FIND",ZTSAVE("AFY")="",ZTSAVE("EFY")="",ZTSAVE("FY")="",ZTSAVE("CFY")="",ZTSAVE("PRC*")="",ZTSAVE("CLEANFIL")="",ZTRTN="^PRCGARCG"
|
|---|
| 35 | D ^PRCFQ
|
|---|
| 36 | END K FY,BFY,EFY,CFY,AFY,NX,MX,ZERONODE,FLAG,X,Y,TREC,CREC,LREC,XPOS,DX,CY,MOP,ARCBIT,DIC,DLAYGO,A,N,M,PERCENT
|
|---|
| 37 | K %DT,ARCHECK,CURSOR,CLEANFIL,D0,DG,DICR,DIG,DIH,DIU,DIV,DIW,ITEMS,MESSAGE,OUT,RTIME,TTIME,YPOS
|
|---|
| 38 | QUIT
|
|---|
