DG53105P.m

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 ---DG53105P   946     printed  Mar 13, 2025@21:40:18                                                                                                                                                                                                     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