DG53432P.m

DG53432P ;BP-CIOFO/MM -Post-init routine for DG*5.3*432 ;12/20/2001

 ;;5.3;Registration;**432**;Aug 13, 1993

 ;

EN ;This patch will update the closeout date for the 12/31/2001 census

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

 ;census.

 ;

 ;Look up 12/31/2001 census record in PTF Census Date (#45.86) file

 N DIC,X,Y

 S DIC="^DG(45.86,"

 S DIC(0)="MZ"

 S X=3011231

 D ^DIC

 I +Y'>0 D  Q

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

 ;Check closeout date and update to 1/19/2002 if necessary.

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

 .D BMES^XPDUTL("   Closeout date for 12/31/2001 currently set for")

 .D MES^XPDUTL("   1/19/2002.  No updating necessary.")

 N DIE,DA,DR

 S DIE="^DG(45.86,"

 S DA=+Y

 S DR=".02////3020119"

 D ^DIE

 D BMES^XPDUTL("   Closeout date for the 12/31/2001 census changed to 1/19/2002.")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53432P   926     printed  Apr 09, 2024@21:50:04                                                                                                                                                                                                     Page 2

DG53432P  ;BP-CIOFO/MM -Post-init routine for DG*5.3*432 ;12/20/2001

 +1       ;;5.3;Registration;**432**;Aug 13, 1993

 +2       ;

EN        ;This patch will update the closeout date for the 12/31/2001 census

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

 +2       ;census.

 +3       ;

 +4       ;Look up 12/31/2001 census record in PTF Census Date (#45.86) file

 +5        NEW DIC,X,Y

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

 +7        SET DIC(0)="MZ"

 +8        SET X=3011231

 +9        DO ^DIC

 +10       IF +Y'>0

               Begin DoDot:1

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

               End DoDot:1

               QUIT 

 +12      ;Check closeout date and update to 1/19/2002 if necessary.

 +13       IF $PIECE(Y(0),U,2)=3020119

               Begin DoDot:1

 +14               DO BMES^XPDUTL("   Closeout date for 12/31/2001 currently set for")

 +15               DO MES^XPDUTL("   1/19/2002.  No updating necessary.")

               End DoDot:1

               QUIT 

 +16       NEW DIE,DA,DR

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

 +18       SET DA=+Y

 +19       SET DR=".02////3020119"

 +20       DO ^DIE

 +21       DO BMES^XPDUTL("   Closeout date for the 12/31/2001 census changed to 1/19/2002.")

 +22       QUIT