DG53P861.m

DG53P861 ;ALB/LG - PRE-INSTALL ROUTINE FOR DG*5.3*861;NOV 2012 ; 3/14/13 1:57pm

 ;;5.3;Registration;**861**;Aug 13, 1993;Build 29

 ; This routine will be used to default the ID FORMAT

 ; Field (#9) of the  ELIGIBILITY CODE FILE (#8) in cases where

 ; the field is set to null.  This file update will coincide

 ; with a modification to make the ID FORMAT Field (#9) of the 

 ; ELIGIBILITY CODE FILE (#8) a required field. 

 Q

EN N DA,DIE,DR,DGELGSTT,DGELDAT,DGVAS

 S DA=0,DGVAS=$O(^DIC(8.2,"B","VA STANDARD","")) ;Check for site specific VA STANDARD assignment 

 F  S DA=$O(^DIC(8,DA)) Q:'DA  D

 .S DGELDAT=$G(^DIC(8,DA,0)),DGELGSTT=$P(DGELDAT,"^",10)

 .I DGELGSTT Q  ;Field already has ID Format Field (#9) defined and should not be updated

 .S DIE=8,DR="9////"_DGVAS ;Update using site specific VA standard assignment

 .D ^DIE

 D BMES^XPDUTL("Pre-Install Routine: ^DG53P861--Complete")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53P861   907     printed  Apr 09, 2024@21:51:48                                                                                                                                                                                                     Page 2

DG53P861  ;ALB/LG - PRE-INSTALL ROUTINE FOR DG*5.3*861;NOV 2012 ; 3/14/13 1:57pm

 +1       ;;5.3;Registration;**861**;Aug 13, 1993;Build 29

 +2       ; This routine will be used to default the ID FORMAT

 +3       ; Field (#9) of the  ELIGIBILITY CODE FILE (#8) in cases where

 +4       ; the field is set to null.  This file update will coincide

 +5       ; with a modification to make the ID FORMAT Field (#9) of the 

 +6       ; ELIGIBILITY CODE FILE (#8) a required field. 

 +7        QUIT 

EN         NEW DA,DIE,DR,DGELGSTT,DGELDAT,DGVAS

 +1       ;Check for site specific VA STANDARD assignment 

           SET DA=0

           SET DGVAS=$ORDER(^DIC(8.2,"B","VA STANDARD",""))

 +2        FOR 

               SET DA=$ORDER(^DIC(8,DA))

               if 'DA

                   QUIT 

               Begin DoDot:1

 +3                SET DGELDAT=$GET(^DIC(8,DA,0))

                   SET DGELGSTT=$PIECE(DGELDAT,"^",10)

 +4       ;Field already has ID Format Field (#9) defined and should not be updated

                   IF DGELGSTT

                       QUIT 

 +5       ;Update using site specific VA standard assignment

                   SET DIE=8

                   SET DR="9////"_DGVAS

 +6                DO ^DIE

               End DoDot:1

 +7        DO BMES^XPDUTL("Pre-Install Routine: ^DG53P861--Complete")

 +8        QUIT