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

DG53288P.m

Go to the documentation of this file.
  1. DG53288P ;BP-CIOFO/MM - Add PTF Quarterly Census date;5/9/00
  1. ;;5.3;Scheduling/Registration;**288**;Aug 13, 1993
  1. ;
  1. ;
  1. CENSUS ;--- add new census date
  1. ; These dates should be updated each quarter, per MAS VACO.
  1. ;
  1. ; **NOTE - the input transform for the .01 field of file 45.86
  1. ; needs to be updated quarterly to the last date of the quarter
  1. ; for this routine to run successfully.
  1. ;
  1. ; Patch will include routine to update dates, and Data Dictionary
  1. ; for .01 field
  1. ;
  1. EN ;
  1. N CENDATE,CLOSDATE,OKTOXM,ACTIVE,CPSTART,ERR
  1. N DA,DD,DIC,DIE,DLAYGO,DO,DR,X,Y
  1. ;
  1. S ERR=0
  1. ;
  1. ;-- ALL DATES ARE FOR FY2000, Q3 CENSUS
  1. ;
  1. ;-- Census Date 6-30-2000
  1. S CENDATE=3000630
  1. ;-- Close-out Date 07-14-2000
  1. S CLOSDATE=3000714
  1. ;
  1. ;-- ok to x-mit PTF date 3-31-1997
  1. ; **no need to change, per Austin
  1. S OKTOXM=2970331
  1. ;-- currently active
  1. S ACTIVE=1
  1. ;-- Census Period Start Date 4-1-2000
  1. S CPSTART=3000401
  1. ;
  1. D BMES^XPDUTL(">>> Updating PTF Census Date File (#45.86) for 3rd Quarter, FY 2000.")
  1. S X=$O(^DG(45.86,"AC",0)) I X S X=$O(^DG(45.86,"AC",X,0)),DIE="^DG(45.86,",DA=X,DR=".04////0" D ^DIE K DIE,DR,DA
  1. S DIC="^DG(45.86,",X=CENDATE,DIC(0)="L",DLAYGO=45.86 K DD,DO D ^DIC K DIC
  1. I Y'>0 S ERR=1 D ERR Q ;checks to see if record is created
  1. S DIE="^DG(45.86,",DA=+Y,DR=".02////"_CLOSDATE_";.03////"_OKTOXM_";.04////"_ACTIVE_";.05////"_CPSTART
  1. D ^DIE K DIE,DR,DA
  1. ;
  1. D MES^XPDUTL("Done.")
  1. Q
  1. ;
  1. ; This will update the PTF CENSUS DATE File (#45.86). The EN tag may be re-run
  1. ERR ;
  1. D BMES^XPDUTL("Problem with PTF CENSUS DATE File (#45.86) Update. Please")
  1. D MES^XPDUTL("contact the National VISTA Support Team for assistance.")
  1. Q