Routine: DG1066P

DG1066P ;ALB/FSB - OTHER FEDERAL AGENCY (#35) FILE UPDATE ; 11/22/21@22:55

 ;;5.3;Registration;**1066**;Aug 13, 1993;Build 2

 ;this routine is used as a post-init in a KIDS build

 ;to modify the name (#.01) to OFFICE OF ECONOMIC OPPORTUNITY

POST ;

 D BMES^XPDUTL("Updating the OTHER FEDERAL AGENCY file (#35)...")

 D UPDATE ; field name update

 D BMES^XPDUTL("Update of the OTHER FEDERAL AGENCY file (#35) completed.")

UPDATE ;

 N DGX,DGXX,DGDA,DA,DR,DIE,DGSTR

 F DGX=1:1 S DGXX=$P($T(CHNG+DGX),";;",2) Q:DGXX=""  D

 .F DGDA=0:0 S DGDA=+$O(^DIC(35,"B",$E($P(DGXX,U,1),1,30),DGDA)) Q:DGDA=0  D

 ..I $D(^DIC(35,DGDA,0)),$P(^DIC(35,DGDA,0),U,1)="OFFICE OF ECONOMIC OPPURTUNITY" D

 ...S DIE="^DIC(35,",DA=DGDA,DR=".01///OFFICE OF ECONOMIC OPPORTUNITY" D ^DIE

 ...D BMES^XPDUTL("Name for "_$P(DGXX,U,1)_" has been updated.")

 ..I '$D(^DIC(35,DGDA,0)) D

 ...S DGSTR="Can't find the record for "_$P(DGXX,U,1)

 ...D BMES^XPDUTL(DGSTR_"... name (#.01) not updated.")

CHNG ;

 ;;OFFICE OF ECONOMIC OPPURTUNITY

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1066P   1039     printed  Jun 11, 2024@22:33:48                                                                                                                                                                                                     Page 2

DG1066P   ;ALB/FSB - OTHER FEDERAL AGENCY (#35) FILE UPDATE ; 11/22/21@22:55

 +1       ;;5.3;Registration;**1066**;Aug 13, 1993;Build 2

 +2       ;

 +3       ;this routine is used as a post-init in a KIDS build

 +4       ;to modify the name (#.01) to OFFICE OF ECONOMIC OPPORTUNITY

 +5       ;

 +6        QUIT

POST      ;

 +1        DO BMES^XPDUTL("Updating the OTHER FEDERAL AGENCY file (#35)...")

 +2       ; field name update

           DO UPDATE

 +3        DO BMES^XPDUTL("Update of the OTHER FEDERAL AGENCY file (#35) completed.")

 +4        QUIT

UPDATE    ;

 +1        NEW DGX,DGXX,DGDA,DA,DR,DIE,DGSTR

 +2        FOR DGX=1:1

               SET DGXX=$PIECE($TEXT(CHNG+DGX),";;",2)

               if DGXX=""

                   QUIT

               Begin DoDot:1

 +3                FOR DGDA=0:0

                       SET DGDA=+$ORDER(^DIC(35,"B",$EXTRACT($PIECE(DGXX,U,1),1,30),DGDA))

                       if DGDA=0

                           QUIT

                       Begin DoDot:2

 +4                        IF $DATA(^DIC(35,DGDA,0))

                               IF $PIECE(^DIC(35,DGDA,0),U,1)="OFFICE OF ECONOMIC OPPURTUNITY"

                                   Begin DoDot:3

 +5                                    SET DIE="^DIC(35,"

                                       SET DA=DGDA

                                       SET DR=".01///OFFICE OF ECONOMIC OPPORTUNITY"

                                       DO ^DIE

 +6                                    DO BMES^XPDUTL("Name for "_$PIECE(DGXX,U,1)_" has been updated.")

                                   End DoDot:3

 +7                        IF '$DATA(^DIC(35,DGDA,0))

                               Begin DoDot:3

 +8                                SET DGSTR="Can't find the record for "_$PIECE(DGXX,U,1)

 +9                                DO BMES^XPDUTL(DGSTR_"... name (#.01) not updated.")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10       QUIT

CHNG      ;

 +1       ;;OFFICE OF ECONOMIC OPPURTUNITY

DG1066P.m