DG53P839 ;ALB/MJB -Post-init routine for DG*5.3*839 Census ; 2/10/11
;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
;
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
DG53P839 ;ALB/MJB -Post-init routine for DG*5.3*839 Census ; 2/10/11
+1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
+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