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 ---[H[J[2J[HDG53432P 926 printed Dec 13, 2024@02:37:27 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
