DG53367A ;ALB/RTK DG*5.3*367 Add new POS entry ; 3/09/01
;;5.3;Registration;**367**;Aug 13, 1993
;
;This routine will add HUMANITARIAN EMERGENCY Eligibility
;code to the ELIGIBILITY multiple of those PERIOD OF
;SERVICE file (#21) entries that do not currently have it.
;These additions are required for the Ineligible Project.
;
N SETERR
S SETERR=0
S IEN21=0
F S IEN21=$O(^DIC(21,IEN21)) Q:'IEN21 D
. I '$D(^DIC(21,IEN21,"E",8)) D
. . K DATA,FDAIEN,IEN,MSG
. . S IEN="+1,"_IEN21_","
. . S DATA(21.01,IEN,.01)=8
. . S FDAIEN(1)=8
. . D UPDATE^DIE("","DATA","FDAIEN","MSG") S SETERR=1
MAIL ; Send a mailman msg to user with results
N DIFROM,%
N DATA1,FILE,IENX,TEXT,I,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,STA
K ^TMP("DG53367A",$J)
S XMSUB="POS File HUMANITARIAN EMERGENCY Add"
S XMDUZ="DG Edit Package",XMY(DUZ)="",XMY(.5)=""
S XMTEXT="^TMP(""DG53367A"",$J,"
D NOW^%DTC S Y=% D DD^%DT
S ^TMP("DG53367A",$J,1)=" Ineligible Project POS Entry Add"
S ^TMP("DG53367A",$J,2)=" "
I SETERR=1 S ^TMP("DG53367A",$J,3)=" New POS entries created successfully."
I SETERR=0 S ^TMP("DG53367A",$J,3)=" New POS entries not created - correct entries already exist."
D ^XMD
K ^TMP("DG53367A",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53367A 1234 printed Sep 23, 2025@20:13:10 Page 2
DG53367A ;ALB/RTK DG*5.3*367 Add new POS entry ; 3/09/01
+1 ;;5.3;Registration;**367**;Aug 13, 1993
+2 ;
+3 ;This routine will add HUMANITARIAN EMERGENCY Eligibility
+4 ;code to the ELIGIBILITY multiple of those PERIOD OF
+5 ;SERVICE file (#21) entries that do not currently have it.
+6 ;These additions are required for the Ineligible Project.
+7 ;
+8 NEW SETERR
+9 SET SETERR=0
+10 SET IEN21=0
+11 FOR
SET IEN21=$ORDER(^DIC(21,IEN21))
if 'IEN21
QUIT
Begin DoDot:1
+12 IF '$DATA(^DIC(21,IEN21,"E",8))
Begin DoDot:2
+13 KILL DATA,FDAIEN,IEN,MSG
+14 SET IEN="+1,"_IEN21_","
+15 SET DATA(21.01,IEN,.01)=8
+16 SET FDAIEN(1)=8
+17 DO UPDATE^DIE("","DATA","FDAIEN","MSG")
SET SETERR=1
End DoDot:2
End DoDot:1
MAIL ; Send a mailman msg to user with results
+1 NEW DIFROM,%
+2 NEW DATA1,FILE,IENX,TEXT,I,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,STA
+3 KILL ^TMP("DG53367A",$JOB)
+4 SET XMSUB="POS File HUMANITARIAN EMERGENCY Add"
+5 SET XMDUZ="DG Edit Package"
SET XMY(DUZ)=""
SET XMY(.5)=""
+6 SET XMTEXT="^TMP(""DG53367A"",$J,"
+7 DO NOW^%DTC
SET Y=%
DO DD^%DT
+8 SET ^TMP("DG53367A",$JOB,1)=" Ineligible Project POS Entry Add"
+9 SET ^TMP("DG53367A",$JOB,2)=" "
+10 IF SETERR=1
SET ^TMP("DG53367A",$JOB,3)=" New POS entries created successfully."
+11 IF SETERR=0
SET ^TMP("DG53367A",$JOB,3)=" New POS entries not created - correct entries already exist."
+12 DO ^XMD
+13 KILL ^TMP("DG53367A",$JOB)
+14 QUIT
