Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCGPUTL

PRCGPUTL.m

Go to the documentation of this file.
  1. PRCGPUTL ;MNT/RB-IFCAP ARCHIVE/PURGE DATE UTILITY ; 01/12/16
  1. V ;;5.1;IFCAP;**193**;JAN 12, 2016;Build 9
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRC*5.1*193 Universal date query for archive/purge options
  1. ;
  1. PURGEDT(PRCGTHRU,PRCGYRS) ;ARCHIVE/PURGE date query
  1. N PRCGDT,OUT D DT S OUT=0
  1. P1 S PRCGDOUT=0,PRCGPGDT=0
  1. 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."
  1. S DIR("?")="Date is converted to last day of FISCAL YEAR associated with entry"
  1. S:PRCGTHRU>0 DIR("B")=PRCGTHRU
  1. D ^DIR K DIR I X["^"!(X="") S OUT=1 G Q
  1. I $E(Y,4,5)>9 S Y=($E(Y,1,3)+1)_"0930"
  1. E S Y=$E(Y,1,3)_"0930"
  1. S PRCGPGDT=Y
  1. I PRCGPGDT>PRCGDT W !,"CANNOT RUN THIS OPTION FOR LESS THAN LAST "_PRCGYRS_" FISCAL YEARS + CURRENT FISCAL YEAR" K PRCGDOUT,PRCGPGDT G P1
  1. D DD^%DT S PRCGDOUT=Y K Y
  1. Q Q OUT
  1. ;
  1. DT N U,X,MM,DD,YY
  1. S U="^"
  1. I '$D(DT) S DT=$$DT^XLFDT
  1. S MM=$E(DT,4,5),DD=$E(DT,6,7),YY=$E(DT,1,3)
  1. S YY=YY-PRCGYRS ;MIN = LAST 7 YEARS + CURRENT
  1. S YY=YY-1,PRCGDT=YY_"0930"
  1. Q