DG53294E.m

DG53294E ;ALB/RTK DG*5.3*294 Add new Enrollment Statuses ; 10/31/00

 ;;5.3;Registration;**294**;Aug 13, 1993

 ;

 ;This routine will add the two new ENROLLMENT STATUS (#27.15) 

 ;records required for the Ineligible Project.

 ;

 N SETERR

 S SETERR=0

 I '$D(^DGEN(27.15,19,0)) D

 .N DATA

 .S DATA(.01)="NOT ELIGIBLE; REFUSED TO PAY COPAY",DATA(.02)="N"

 .I $$ADD^DGENDBS(27.15,,.DATA) D

 ..S DATA(.01)="NOT ELIGIBLE; INELIGIBLE DATE"

 ..I $$ADD^DGENDBS(27.15,,.DATA) D

 ...S SETERR=1 D BMES^XPDUTL(" New ENROLLMENT STATUS entries created successfully.")

 E  I $G(^DGEN(27.15,19,0))="NOT ELIGIBLE; REFUSED TO PAY COPAY^N" S SETERR=2

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("DG53294E",$J)

 S XMSUB="ELIGIBILITY STATUS Add"

 S XMDUZ="DG Edit Package",XMY(DUZ)="",XMY(.5)=""

 S XMTEXT="^TMP(""DG53294E"",$J,"

 D NOW^%DTC S Y=% D DD^%DT

 S ^TMP("DG53294E",$J,1)=" Ineligible Project ELIGIBILITY STATUS Add"

 S ^TMP("DG53294E",$J,2)="  "

 I SETERR=1 S ^TMP("DG53294E",$J,3)=" New ENROLLMENT STATUS entries created successfully."

 I SETERR=0 S ^TMP("DG53294E",$J,3)=" New ENROLLMENT STATUS entries were not created successfully."

 I SETERR=2 S ^TMP("DG53294E",$J,3)=" New ENROLLMENT STATUS entries already exist on the system."

 D ^XMD

 K ^TMP("DG53294E",$J)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53294E   1368     printed  Apr 09, 2024@21:46:56                                                                                                                                                                                                    Page 2

DG53294E  ;ALB/RTK DG*5.3*294 Add new Enrollment Statuses ; 10/31/00

 +1       ;;5.3;Registration;**294**;Aug 13, 1993

 +2       ;

 +3       ;This routine will add the two new ENROLLMENT STATUS (#27.15) 

 +4       ;records required for the Ineligible Project.

 +5       ;

 +6        NEW SETERR

 +7        SET SETERR=0

 +8        IF '$DATA(^DGEN(27.15,19,0))

               Begin DoDot:1

 +9                NEW DATA

 +10               SET DATA(.01)="NOT ELIGIBLE; REFUSED TO PAY COPAY"

                   SET DATA(.02)="N"

 +11               IF $$ADD^DGENDBS(27.15,,.DATA)

                       Begin DoDot:2

 +12                       SET DATA(.01)="NOT ELIGIBLE; INELIGIBLE DATE"

 +13                       IF $$ADD^DGENDBS(27.15,,.DATA)

                               Begin DoDot:3

 +14                               SET SETERR=1

                                   DO BMES^XPDUTL(" New ENROLLMENT STATUS entries created successfully.")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15      IF '$TEST

               IF $GET(^DGEN(27.15,19,0))="NOT ELIGIBLE; REFUSED TO PAY COPAY^N"

                   SET SETERR=2

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("DG53294E",$JOB)

 +4        SET XMSUB="ELIGIBILITY STATUS Add"

 +5        SET XMDUZ="DG Edit Package"

           SET XMY(DUZ)=""

           SET XMY(.5)=""

 +6        SET XMTEXT="^TMP(""DG53294E"",$J,"

 +7        DO NOW^%DTC

           SET Y=%

           DO DD^%DT

 +8        SET ^TMP("DG53294E",$JOB,1)=" Ineligible Project ELIGIBILITY STATUS Add"

 +9        SET ^TMP("DG53294E",$JOB,2)="  "

 +10       IF SETERR=1

               SET ^TMP("DG53294E",$JOB,3)=" New ENROLLMENT STATUS entries created successfully."

 +11       IF SETERR=0

               SET ^TMP("DG53294E",$JOB,3)=" New ENROLLMENT STATUS entries were not created successfully."

 +12       IF SETERR=2

               SET ^TMP("DG53294E",$JOB,3)=" New ENROLLMENT STATUS entries already exist on the system."

 +13       DO ^XMD

 +14       KILL ^TMP("DG53294E",$JOB)

 +15       QUIT