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 ---[H[J[2J[HDG53P861 907 printed Dec 13, 2024@02:40:16 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
