DG53105P ;ALB/MLI - Post-Installation to cleanup PAF file ; Oct 1, 1996
;;5.3;Registration;**105**;Aug 13, 1993
;
; This patch will loop through the 10/1/96 census PAF records and
; ensure the LOCATION field is properly defined.
;
EN ; start process
N DGCOUNT
S DGCOUNT=0
D BMES^XPDUTL("Starting Cleanup of PAF file (#45.9)...")
D CLEAN
D BMES^XPDUTL("Cleanup complete..."_DGCOUNT_" records altered")
Q
;
;
CLEAN ; loop through 10/1/96 semi-annual assessments and check location field
N DA,DGDATE,DGIEN,DGLOC,DIE,DR
S DGDATE=2960900
S DIE="^DG(45.9,"
F S DGDATE=$O(^DG(45.9,"AP",2,DGDATE)) Q:'DGDATE D
. S DGIEN=""
. F S DGIEN=$O(^DG(45.9,"AP",2,DGDATE,DGIEN)) Q:'DGIEN D
. . S DGLOC=$P($G(^DG(45.9,DGIEN,"R")),"^",1)
. . I $P(DGLOC,";DIC(42,",2,999)']"" Q ; no extra charcters
. . S DGLOC=+DGLOC_";DIC(42,",DGCOUNT=DGCOUNT+1
. . S DA=DGIEN,DR="70////^S X=DGLOC"
. . D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53105P 946 printed Nov 22, 2024@17:45:44 Page 2
DG53105P ;ALB/MLI - Post-Installation to cleanup PAF file ; Oct 1, 1996
+1 ;;5.3;Registration;**105**;Aug 13, 1993
+2 ;
+3 ; This patch will loop through the 10/1/96 census PAF records and
+4 ; ensure the LOCATION field is properly defined.
+5 ;
EN ; start process
+1 NEW DGCOUNT
+2 SET DGCOUNT=0
+3 DO BMES^XPDUTL("Starting Cleanup of PAF file (#45.9)...")
+4 DO CLEAN
+5 DO BMES^XPDUTL("Cleanup complete..."_DGCOUNT_" records altered")
+6 QUIT
+7 ;
+8 ;
CLEAN ; loop through 10/1/96 semi-annual assessments and check location field
+1 NEW DA,DGDATE,DGIEN,DGLOC,DIE,DR
+2 SET DGDATE=2960900
+3 SET DIE="^DG(45.9,"
+4 FOR
SET DGDATE=$ORDER(^DG(45.9,"AP",2,DGDATE))
if 'DGDATE
QUIT
Begin DoDot:1
+5 SET DGIEN=""
+6 FOR
SET DGIEN=$ORDER(^DG(45.9,"AP",2,DGDATE,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:2
+7 SET DGLOC=$PIECE($GET(^DG(45.9,DGIEN,"R")),"^",1)
+8 ; no extra charcters
IF $PIECE(DGLOC,";DIC(42,",2,999)']""
QUIT
+9 SET DGLOC=+DGLOC_";DIC(42,"
SET DGCOUNT=DGCOUNT+1
+10 SET DA=DGIEN
SET DR="70////^S X=DGLOC"
+11 DO ^DIE
End DoDot:2
End DoDot:1
+12 QUIT