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

DG53336P.m

Go to the documentation of this file.
  1. DG53336P ;ALB-CIOFO/MRY - Add PTF Quarterly Census date;11/16/00
  1. ;;5.3;Scheduling/Registration;**336**;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 FY2001, Q1 CENSUS
  1. ;
  1. ;-- Census Date 12-31-2000
  1. S CENDATE=3001231
  1. ;-- Close-out Date 01-19-2001
  1. S CLOSDATE=3010119
  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 10-1-2000
  1. S CPSTART=3001001
  1. ;
  1. D BMES^XPDUTL(">>> Updating PTF Census Date File (#45.86) for 1st Quarter, FY 2001.")
  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