DG53729C.m

DG53729C ;ALB/MRY -Post-init routine for DG*5.3*729 Census ;7/19/2007

 ;;5.3;Registration;**729,1015**;Aug 13, 1993;Build 21

 ;

EN ;This patch will update the closeout date for the 9/30/2007 census

 ;if an entry exists in the PTF Census Date (#45.86) file for that

 ;census.

 ;

 ;Look up 9/30/2007 census record in PTF Census Date (#45.86) file

 D BMES^XPDUTL("***** Updating PTF Census *****")

 N DIC,X,Y

 S DIC="^DG(45.86,"

 S DIC(0)="MZ"

 S X=3070930

 D ^DIC

 I +Y'>0 D  Q

 .D BMES^XPDUTL("   9/30/2007 census record does not exist in PTF Census Date (#45.86) file.  No update needed.")

 ;Check closeout date and update to 10/14/2007 if necessary.

 I $P(Y(0),U,2)=3071014 D  Q

 .D BMES^XPDUTL("   Closeout date for 9/30/2007 currently set for")

 .D MES^XPDUTL("   10/14/2007.  No updating necessary.")

 N DIE,DA,DR

 S DIE="^DG(45.86,"

 S DA=+Y

 S DR=".02////3071014"

 D ^DIE

 D BMES^XPDUTL("   Closeout date for the 9/30/2007 census changed to 10/14/2007.")

 Q

DG53729C  ;ALB/MRY -Post-init routine for DG*5.3*729 Census ;7/19/2007

 +1       ;;5.3;Registration;**729,1015**;Aug 13, 1993;Build 21

 +2       ;

EN        ;This patch will update the closeout date for the 9/30/2007 census

 +1       ;if an entry exists in the PTF Census Date (#45.86) file for that

 +2       ;census.

 +3       ;

 +4       ;Look up 9/30/2007 census record in PTF Census Date (#45.86) file

 +5        DO BMES^XPDUTL("***** Updating PTF Census *****")

 +6        NEW DIC,X,Y

 +7        SET DIC="^DG(45.86,"

 +8        SET DIC(0)="MZ"

 +9        SET X=3070930

 +10       DO ^DIC

 +11       IF +Y'>0

               Begin DoDot:1

 +12               DO BMES^XPDUTL("   9/30/2007 census record does not exist in PTF Census Date (#45.86) file.  No update needed.")

               End DoDot:1

               QUIT 

 +13      ;Check closeout date and update to 10/14/2007 if necessary.

 +14       IF $PIECE(Y(0),U,2)=3071014

               Begin DoDot:1

 +15               DO BMES^XPDUTL("   Closeout date for 9/30/2007 currently set for")

 +16               DO MES^XPDUTL("   10/14/2007.  No updating necessary.")

               End DoDot:1

               QUIT 

 +17       NEW DIE,DA,DR

 +18       SET DIE="^DG(45.86,"

 +19       SET DA=+Y

 +20       SET DR=".02////3071014"

 +21       DO ^DIE

 +22       DO BMES^XPDUTL("   Closeout date for the 9/30/2007 census changed to 10/14/2007.")

 +23       QUIT