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
;
Q
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.")
Q
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.")
Q
CHNG ;
;;OFFICE OF ECONOMIC OPPURTUNITY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1066P 1039 printed Nov 22, 2024@17:45:12 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
