PRCGPUTL.m

PRCGPUTL ;MNT/RB-IFCAP ARCHIVE/PURGE DATE UTILITY ; 01/12/16

V ;;5.1;IFCAP;**193**;JAN 12, 2016;Build 9

 ;Per VA Directive 6402, this routine should not be modified.

 ;

 ;PRC*5.1*193 Universal date query for archive/purge options

 ;

PURGEDT(PRCGTHRU,PRCGYRS) ;ARCHIVE/PURGE date query

 N PRCGDT,OUT D DT S OUT=0

P1 S PRCGDOUT=0,PRCGPGDT=0

 S DIR(0)="D^::E",DIR("A")="Select Fiscal Year thru which this option is to run",DIR("?",1)="Enter a valid FileMan date (YYYY is valid), or an up-arrow to quit."

 S DIR("?")="Date is converted to last day of FISCAL YEAR associated with entry"

 S:PRCGTHRU>0 DIR("B")=PRCGTHRU

 D ^DIR K DIR I X["^"!(X="") S OUT=1 G Q

 I $E(Y,4,5)>9 S Y=($E(Y,1,3)+1)_"0930"

 E  S Y=$E(Y,1,3)_"0930"

 S PRCGPGDT=Y

 I PRCGPGDT>PRCGDT W !,"CANNOT RUN THIS OPTION FOR LESS THAN LAST "_PRCGYRS_" FISCAL YEARS + CURRENT FISCAL YEAR" K PRCGDOUT,PRCGPGDT G P1

 D DD^%DT S PRCGDOUT=Y K Y

Q Q OUT

 ;

DT N U,X,MM,DD,YY

 S U="^"

 I '$D(DT) S DT=$$DT^XLFDT

 S MM=$E(DT,4,5),DD=$E(DT,6,7),YY=$E(DT,1,3)

 S YY=YY-PRCGYRS    ;MIN = LAST 7 YEARS + CURRENT

 S YY=YY-1,PRCGDT=YY_"0930"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCGPUTL   1118     printed  Apr 09, 2024@21:12:47                                                                                                                                                                                                    Page 2

PRCGPUTL  ;MNT/RB-IFCAP ARCHIVE/PURGE DATE UTILITY ; 01/12/16

V         ;;5.1;IFCAP;**193**;JAN 12, 2016;Build 9

 +1       ;Per VA Directive 6402, this routine should not be modified.

 +2       ;

 +3       ;PRC*5.1*193 Universal date query for archive/purge options

 +4       ;

PURGEDT(PRCGTHRU,PRCGYRS) ;ARCHIVE/PURGE date query

 +1        NEW PRCGDT,OUT

           DO DT

           SET OUT=0

P1         SET PRCGDOUT=0

           SET PRCGPGDT=0

 +1        SET DIR(0)="D^::E"

           SET DIR("A")="Select Fiscal Year thru which this option is to run"

           SET DIR("?",1)="Enter a valid FileMan date (YYYY is valid), or an up-arrow to quit."

 +2        SET DIR("?")="Date is converted to last day of FISCAL YEAR associated with entry"

 +3        if PRCGTHRU>0

               SET DIR("B")=PRCGTHRU

 +4        DO ^DIR

           KILL DIR

           IF X["^"!(X="")

               SET OUT=1

               GOTO Q

 +5        IF $EXTRACT(Y,4,5)>9

               SET Y=($EXTRACT(Y,1,3)+1)_"0930"

 +6       IF '$TEST

               SET Y=$EXTRACT(Y,1,3)_"0930"

 +7        SET PRCGPGDT=Y

 +8        IF PRCGPGDT>PRCGDT

               WRITE !,"CANNOT RUN THIS OPTION FOR LESS THAN LAST "_PRCGYRS_" FISCAL YEARS + CURRENT FISCAL YEAR"

               KILL PRCGDOUT,PRCGPGDT

               GOTO P1

 +9        DO DD^%DT

           SET PRCGDOUT=Y

           KILL Y

Q          QUIT OUT

 +1       ;

DT         NEW U,X,MM,DD,YY

 +1        SET U="^"

 +2        IF '$DATA(DT)

               SET DT=$$DT^XLFDT

 +3        SET MM=$EXTRACT(DT,4,5)

           SET DD=$EXTRACT(DT,6,7)

           SET YY=$EXTRACT(DT,1,3)

 +4       ;MIN = LAST 7 YEARS + CURRENT

           SET YY=YY-PRCGYRS

 +5        SET YY=YY-1

           SET PRCGDT=YY_"0930"

 +6        QUIT