DG53121P ;ALB/CJM - LOCAL ENROLLMENT ENHANCEMENT POST INSTALL UPDATES; 7/23/97
;;5.3;Registration;**121**;Aug 13, 1993
;
EN ;
;-- update Eligibility file #8
D ELIG
Q
;
ELIG ;-- This function will add a CATASTROPHICALLY DISABLED eligibility to file #8
;
N X,Y,DGE,DIC,DIE,DR,DA,D0
;
D BMES^XPDUTL(">>> Adding 'CATASTROPHICALLY DISABLED' to the Eligibility file #8.")
S X=$O(^DIC(8,"B","CATASTROPHICALLY DISABLED",0))
I X D BMES^XPDUTL(" --- Entry Already exists! --- ") G ELIGQ
;
; else add entry to file
S DGE=$O(^DIC(8.1,"B","CATASTROPHICALLY DISABLED",0))
S DIC="^DIC(8,",X="CATASTROPHICALLY DISABLED"
S DIC("DR")="1///^S X=""BLUE"";2///^S X=""CD"";4///^S X=""Y"";5///^S X=""CATASTROP. DISAB."";7///1;3///10;9///^S X=""VA STANDARD"";11///^S X=""VA"";8////"_DGE,DIC(0)="LS"
D FILE^DICN
I ((+Y)>0) D BMES^XPDUTL(" Entry Successfully Added. ")
I Y=-1 D BMES^XPDUTL(" Entry was NOT successfully added. ")
;
ELIGQ ;
D BMES^XPDUTL("Done.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53121P 992 printed Dec 13, 2024@02:36:06 Page 2
DG53121P ;ALB/CJM - LOCAL ENROLLMENT ENHANCEMENT POST INSTALL UPDATES; 7/23/97
+1 ;;5.3;Registration;**121**;Aug 13, 1993
+2 ;
EN ;
+1 ;-- update Eligibility file #8
+2 DO ELIG
+3 QUIT
+4 ;
ELIG ;-- This function will add a CATASTROPHICALLY DISABLED eligibility to file #8
+1 ;
+2 NEW X,Y,DGE,DIC,DIE,DR,DA,D0
+3 ;
+4 DO BMES^XPDUTL(">>> Adding 'CATASTROPHICALLY DISABLED' to the Eligibility file #8.")
+5 SET X=$ORDER(^DIC(8,"B","CATASTROPHICALLY DISABLED",0))
+6 IF X
DO BMES^XPDUTL(" --- Entry Already exists! --- ")
GOTO ELIGQ
+7 ;
+8 ; else add entry to file
+9 SET DGE=$ORDER(^DIC(8.1,"B","CATASTROPHICALLY DISABLED",0))
+10 SET DIC="^DIC(8,"
SET X="CATASTROPHICALLY DISABLED"
+11 SET DIC("DR")="1///^S X=""BLUE"";2///^S X=""CD"";4///^S X=""Y"";5///^S X=""CATASTROP. DISAB."";7///1;3///10;9///^S X=""VA STANDARD"";11///^S X=""VA"";8////"_DGE
SET DIC(0)="LS"
+12 DO FILE^DICN
+13 IF ((+Y)>0)
DO BMES^XPDUTL(" Entry Successfully Added. ")
+14 IF Y=-1
DO BMES^XPDUTL(" Entry was NOT successfully added. ")
+15 ;
ELIGQ ;
+1 DO BMES^XPDUTL("Done.")
+2 QUIT
