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

DG5398PT.m

Go to the documentation of this file.
  1. DG5398PT ;ALB/ABR - ANNUAL PATIENT CENSUS CLOSEOUT OF PTF; 7/18/96
  1. ;;5.3;Registration;**98**;Aug 13, 1993
  1. ;
  1. ;
  1. CENSUS ;--- add new census date
  1. ; These dates should be update each year per MAS VACO.
  1. EN ;
  1. N CENDATE,CLOSDATE,OKTOXM,ACTIVE,CPSTART,ERR
  1. S ERR=0
  1. ;
  1. ;-- ALL DATES ARE FOR '96 CENSUS
  1. ;
  1. ;-- Census Date 9-30-96
  1. S CENDATE=2960930
  1. ;-- Close-out Date 11-01-96
  1. S CLOSDATE=2961101
  1. ;-- ok to x-mit PTF date 11-18-96
  1. S OKTOXM=2961118
  1. ;-- currently active
  1. S ACTIVE=1
  1. ;-- Census Period Start Date 10-1-9
  1. S CPSTART=2951001
  1. ;
  1. D BMES^XPDUTL(">>> Updating PTF Census Date File (#45.86) for FY 1996.")
  1. ;
  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" 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. I +ERR D BMES^XPDUTL("Problem with PTF CENSUS DATE File (#45.86) Update. Call your IRMFO CS.")
  1. Q