DG53367A.m

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 ---DG53367A   1234     printed  Apr 09, 2024@21:49:07                                                                                                                                                                                                    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