EAS1P7 ;ALB/LBD - Post Init for EAS*1.0*7 ;12 MAR 2002
;;1.0;ENROLLMENT APPLICATION SYSTEM;**7**;Mar 15, 2001
;
POST ; Entry point for post init
;
; Update LTC COPAY EXEMPTION file (#714.1)
D MES^XPDUTL("*** Updating LTC COPAY EXEMPTION (File #714.1) ***")
N DIC,DA,DIE,X,Y,FILE
; Modify entry #2
D MES^XPDUTL(" - Modifying entry #2")
S FILE="^EAS(714.1,"
S DIC=FILE,DIC(0)="N",X=2 D ^DIC
I Y<0 D MES^XPDUTL(" ERROR: Entry #2 not updated")
E S DIE=FILE,DA=2,DR=".01///INCOME (LAST YEAR) BELOW LTC THRESHOLD" D ^DIE
; Add entry #12
D MES^XPDUTL(" - Adding entry #12")
K DO
S DIC=FILE,DIC(0)="F",(DA,DINUM)=12
S X="INCOME (CURRENT YEAR) BELOW LTC THRESHOLD",DIC("DR")=".02////1"
D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1P7 737 printed Dec 13, 2024@01:53:34 Page 2
EAS1P7 ;ALB/LBD - Post Init for EAS*1.0*7 ;12 MAR 2002
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**7**;Mar 15, 2001
+2 ;
POST ; Entry point for post init
+1 ;
+2 ; Update LTC COPAY EXEMPTION file (#714.1)
+3 DO MES^XPDUTL("*** Updating LTC COPAY EXEMPTION (File #714.1) ***")
+4 NEW DIC,DA,DIE,X,Y,FILE
+5 ; Modify entry #2
+6 DO MES^XPDUTL(" - Modifying entry #2")
+7 SET FILE="^EAS(714.1,"
+8 SET DIC=FILE
SET DIC(0)="N"
SET X=2
DO ^DIC
+9 IF Y<0
DO MES^XPDUTL(" ERROR: Entry #2 not updated")
+10 IF '$TEST
SET DIE=FILE
SET DA=2
SET DR=".01///INCOME (LAST YEAR) BELOW LTC THRESHOLD"
DO ^DIE
+11 ; Add entry #12
+12 DO MES^XPDUTL(" - Adding entry #12")
+13 KILL DO
+14 SET DIC=FILE
SET DIC(0)="F"
SET (DA,DINUM)=12
+15 SET X="INCOME (CURRENT YEAR) BELOW LTC THRESHOLD"
SET DIC("DR")=".02////1"
+16 DO FILE^DICN
+17 QUIT
