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 ---[H[J[2J[HDG53294E 1368 printed Sep 23, 2025@20:12:55 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
