DG53P839.m

DG53P839 ;ALB/MJB -Post-init routine for DG*5.3*839 Census ; 2/10/11

 ;;5.3;Registration;**839**;Aug 13, 1993;Build 3

 ;

 Q

EN ;This patch will update the closeout date for the 3/31/2011 census

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

 ;census.

 ;

 ;Look up 3/31/2011 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=3110331

 D ^DIC

 I +Y'>0 D  Q

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

 ;Check closeout date and update to 4/07/2011 if necessary.

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

 .D BMES^XPDUTL("   Closeout date for 3/31/2011 currently set for")

 .D MES^XPDUTL("   4/07/2011.  No updating necessary.")

 N DIE,DA,DR

 S DIE="^DG(45.86,"

 S DA=+Y

 S DR=".02////3110407"

 D ^DIE

 D BMES^XPDUTL("   Closeout date for the 3/31/2011 census changed to 4/07/2011.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53P839   985     printed  Apr 09, 2024@21:46:55                                                                                                                                                                                                     Page 2

DG53P839  ;ALB/MJB -Post-init routine for DG*5.3*839 Census ; 2/10/11

 +1       ;;5.3;Registration;**839**;Aug 13, 1993;Build 3

 +2       ;

 +3        QUIT 

EN        ;This patch will update the closeout date for the 3/31/2011 census

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

 +2       ;census.

 +3       ;

 +4       ;Look up 3/31/2011 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=3110331

 +10       DO ^DIC

 +11       IF +Y'>0

               Begin DoDot:1

 +12               DO BMES^XPDUTL("   3/31/2011 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 4/07/2011 if necessary.

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

               Begin DoDot:1

 +15               DO BMES^XPDUTL("   Closeout date for 3/31/2011 currently set for")

 +16               DO MES^XPDUTL("   4/07/2011.  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////3110407"

 +21       DO ^DIE

 +22       DO BMES^XPDUTL("   Closeout date for the 3/31/2011 census changed to 4/07/2011.")

 +23       QUIT