Routine: DGENRPD2

DGENRPD2 ;ALB/CJM/EG -Veteran with Future Appts and no Enrollment App Report - Continue 01/19/2005 ; 1/20/05 1:27pm

 ;;5.3;PIMS;**147,232,568,585,725,767,1015,1016**;JUN 30, 2012;Build 20

PRINT ;

 N CRT,QUIT,PAGE,SUBSCRPT

 K ^TMP($J)

 S QUIT=0

 S PAGE=0

 S CRT=$S($E(IOST,1,2)="C-":1,1:0)

 D GETPAT

 U IO

 I CRT,PAGE=0 W @IOF

 S PAGE=1

 D HEADER

 F SUBSCRPT="STEP2","NOENREC" D

 .D PATIENTS(SUBSCRPT)

 I CRT,'QUIT D PAUSE

 I $D(ZTQUEUED) S ZTREQ="@"

 D ^%ZISC

 K ^TMP($J)

LINE(LINE) ;

 ;Description: prints a line. First prints header if at end of page.

 I CRT,($Y>(IOSL-4)) D

 .D PAUSE

 .Q:QUIT

 .W @IOF

 .D HEADER

 .W LINE

 E  I ('CRT),($Y>(IOSL-2)) D

 .W @IOF

 .D HEADER

 .W LINE

 E  W !,LINE

GETPAT ;

 ; Description: Gets patients to include in the report

 N BEGIN,END,DGARRAY,SDCNT,CATEGORY,DIVISION,NAM

 S BEGIN=DGENRP("BEGIN")_".0000",END=DGENRP("END")_".2359",DGARRAY(1)=BEGIN_";"_END

 S DGARRAY("FLDS")="3;10",SDCNT=$$SDAPI^SDAMA301(.DGARRAY)

 ;there must be subscripts underneath the 101 level to be a

 ;valid appointment, else it is an error eg 01/20/2005

 ; Appointment Database is Unavailable

 I SDCNT<0 N X S X=$$FAPCHK I X'="" S NAM=X G ERR

 ; Get All records for report

 I DGENRP("ALL") D

 .S CLINIC=0 F  S CLINIC=$O(^TMP($J,"SDAMA301",CLINIC)) Q:'CLINIC  D

 ..Q:$P($G(^SC(CLINIC,0)),"^",3)'="C"

 ..S DFN=0 F  S DFN=$O(^TMP($J,"SDAMA301",CLINIC,DFN)) Q:'DFN  D

 ...S DIVISION=$P($G(^SC(CLINIC,0)),U,15)

 ...S:'DIVISION DIVISION=$O(^DG(40.8,0))

 ...D VALREC(CLINIC,DFN)

 ; Get records for specified Divisions only

 I $O(DGENRP("DIVISION",0)) D

 .S CLINIC=0 F  S CLINIC=$O(^TMP($J,"SDAMA301",CLINIC)) Q:'CLINIC  D

 ..Q:$P($G(^SC(CLINIC,0)),"^",3)'="C"

 ..S DIVISION=$P($G(^SC(CLINIC,0)),U,15)

 ..S:'DIVISION DIVISION=$O(^DG(40.8,0))

 ..Q:'DIVISION!('$D(DGENRP("DIVISION",DIVISION)))

 ..S DFN=0 F  S DFN=$O(^TMP($J,"SDAMA301",CLINIC,DFN)) Q:'DFN  D VALREC(CLINIC,DFN)

 ; Get records for specified Clinics only

 I $O(DGENRP("CLINIC",0)) D

 .S CLINIC=0 F  S CLINIC=$O(^TMP($J,"SDAMA301",CLINIC)) Q:'CLINIC  D

 ..Q:'CLINIC!('$D(DGENRP("CLINIC",CLINIC)))

 ..Q:($P($G(^SC(CLINIC,0)),U,3)'="C")

 ..S DIVISION=$P($G(^SC(CLINIC,0)),U,15)

 ..S:'DIVISION DIVISION=$O(^DG(40.8,0))

 ..S DFN=0 F  S DFN=$O(^TMP($J,"SDAMA301",CLINIC,DFN)) Q:'DFN  D VALREC(CLINIC,DFN)

 K DGARRAY,^TMP($J,"SDAMA301"),SDCNT

ERR ;

 ;^TMP($J,TYPE,DIVISION NAME,CLINIC NAME,CATEGORY,APPT DT/TM,DFN)

 I NAM["Appointment Database is unavailable. Please try again later." S NAM="**Appointment Database is Unavailable**"

 I NAM["Appointment request contains invalid values." S NAM="**Invalid appointment, call Help Desk**"

 I NAM["An error has occurred. Check the RSA Error Log." S NAM="**Error,  check RSA Error Log **"

 S ^TMP($J,"NOENREC"," ",NAM," ",DT," ")=""

 K DGARRAY,^TMP($J,"SDAMA301"),SDCNT,NAM

VALREC(CLINIC,DFN) ;

 N APPT,STATUS,JUSTONCE S JUSTONCE=0

 S APPT=0 F  S APPT=$O(^TMP($J,"SDAMA301",CLINIC,DFN,APPT)) Q:'APPT!(JUSTONCE)  D

 .S JUSTONCE=+$G(DGENRP("JUSTONCE"))

 .; Exclude certain appointment statuses

 .S STATUS=$P($P(^TMP($J,"SDAMA301",CLINIC,DFN,APPT),U,3),";")

 .Q:"^NS^NSR^CC^CCR^CP^CPR^"[(U_STATUS_U)

.;

 .; Don't include enrolled veterans or ones that have pending apps

 .S CATEGORY=$$CATEGORY^DGENA4(DFN)

 .I (CATEGORY="E")!(CATEGORY="P") Q

.;

 .; Exclude if not an eligible veteran (can not enroll)

 .Q:'$$VET^DGENPTA(DFN)

.;

 .D SETTMP(CLINIC,DFN,APPT)

SETTMP(CLINIC,DFN,APPT) ;

 ; NOENREC is for patients without enrollment records

 ; SITE2 is for other excluded enrollment records

 ;^TMP($J,TYPE,DIVISION NAME,CLINIC NAME,CATEGORY,APPT DT/TM,DFN)

 N DIVNAME,CLNAME

 S DIVNAME=$S(DIVISION:$P($$SITE^VASITE(APPT\1,DIVISION),U,2),1:" ")

 S CLNAME=$P($G(^SC(CLINIC,0)),"^")

 S:CLNAME="" CLNAME=" "

 I $$FINDCUR^DGENA(DFN)="" S ^TMP($J,"NOENREC",DIVNAME,CLNAME,CATEGORY,APPT,DFN)="" Q

 S ^TMP($J,"STEP2",DIVNAME,CLNAME,CATEGORY,APPT,DFN)=$$STATUS^DGENA(DFN)_U_$P($P(^TMP($J,"SDAMA301",CLINIC,DFN,APPT),U,10),";",2)

HEADER ;

 ;Description: Prints the report header.

 N LINE

 I $Y>1 W @IOF

 W !,"Appointments for Veterans with no Enrollment Application"

 W:DGENRP("BEGIN") ?70,"Date Range: "_$$FMTE^XLFDT(DGENRP("BEGIN"))_" to "_$$FMTE^XLFDT($G(DGENRP("END")))

 W ?120,"Page ",PAGE

 S PAGE=PAGE+1

W !

 W ?70," Run Date: "_$$FMTE^XLFDT(DT)

W !

 W !,"Name",?39,"PatientID",?57,"DOB",?70,"Appt Dt/Tm",?90,"EnrollStatus",?121,"Enroll Cat"

 S $P(LINE,"-",132)="-"

 W !,LINE,!

PAUSE ;

 ;Description: Screen pause.  Sets QUIT=1 if user decides to quit.

 N DIR,X,Y

 F  Q:$Y>(IOSL-3)  W !

 S DIR(0)="E"

 D ^DIR

 I ('(+Y))!$D(DIRUT) S QUIT=1

PATIENTS(SUBSCRPT) ;

 ;Description: Prints list of patients

 N NODE,DIVISION,CLINIC,TIME,PATIENT,DGPAT,APPTYPE,ENRSTAT,CATEGORY

 S DIVISION=""

 F  S DIVISION=$O(^TMP($J,SUBSCRPT,DIVISION)) Q:DIVISION=""  D  Q:QUIT

 .D LINE("  ") Q:QUIT

 .D LINE($$LJ(" ",40)_"DIVISION: "_DIVISION) Q:QUIT

 .D LINE("  ") Q:QUIT

 .S CLINIC=""

 .F  S CLINIC=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC)) Q:CLINIC=""  D  Q:QUIT

 ..D LINE("  ") Q:QUIT

 ..D LINE("CLINIC: "_$$LJ(CLINIC,40)_$$LJ(" ",40)_"DIVISION: "_DIVISION)

 ..Q:QUIT

 ..S CATEGORY=""

 ..F  S CATEGORY=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY)) Q:CATEGORY=""  D  Q:QUIT

 ...D LINE(" ") Q:QUIT

 ...S TIME=0

 ...F  S TIME=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME)) Q:'TIME  D  Q:QUIT

 ....S DFN=0

 ....F  S DFN=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME,DFN)) Q:'DFN  D  Q:QUIT

 .....S NODE=$G(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME,DFN))

 .....S ENRSTAT=$P(NODE,"^")

 .....S APPTYPE=$P(NODE,"^",2)

 .....Q:'$$GET^DGENPTA(DFN,.DGPAT)

 .....S LINE=$$LJ(DGPAT("NAME"),37)_" "_$$LJ(DGPAT("PID"),15)_" "

 .....S LINE=LINE_$$LJ($$DATE(DGPAT("DOB")),12)_"  "

 .....S LINE=LINE_$$LJ($$DATE(TIME),20)

 .....S LINE=LINE_"  "_$$LJ($S(ENRSTAT="":"NO ENROLLMENT RECORD",1:$$EXT^DGENU("STATUS",ENRSTAT)),28)

 .....S LINE=LINE_$$LJ(" ",2)_$$EXTCAT^DGENA4(CATEGORY)

 .....D LINE(LINE)

 .....Q:QUIT

DATE(DATE) ;

 Q $$FMTE^XLFDT(DATE,"1")

LJ(STRING,LENGTH) ;

 Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)

FAPCHK() ;

 N ERR

 S ERR=$O(^TMP($J,"SDAMA301",""))

 I $D(^TMP($J,"SDAMA301",ERR))=1 Q ^TMP($J,"SDAMA301",ERR)

 Q ""

DGENRPD2  ;ALB/CJM/EG -Veteran with Future Appts and no Enrollment App Report - Continue 01/19/2005 ; 1/20/05 1:27pm

 +1       ;;5.3;PIMS;**147,232,568,585,725,767,1015,1016**;JUN 30, 2012;Build 20

 +2       ;

PRINT     ;

 +1        NEW CRT,QUIT,PAGE,SUBSCRPT

 +2        KILL ^TMP($JOB)

 +3        SET QUIT=0

 +4        SET PAGE=0

 +5        SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)

 +6       ;

 +7        DO GETPAT

 +8        USE IO

 +9        IF CRT

               IF PAGE=0

                   WRITE @IOF

 +10       SET PAGE=1

 +11       DO HEADER

 +12       FOR SUBSCRPT="STEP2","NOENREC"

               Begin DoDot:1

 +13               DO PATIENTS(SUBSCRPT)

               End DoDot:1

 +14       IF CRT

               IF 'QUIT

                   DO PAUSE

 +15       IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +16       DO ^%ZISC

 +17      ;

 +18       KILL ^TMP($JOB)

 +19       QUIT

LINE(LINE) ;

 +1       ;Description: prints a line. First prints header if at end of page.

 +2       ;

 +3        IF CRT

               IF ($Y>(IOSL-4))

                   Begin DoDot:1

 +4                    DO PAUSE

 +5                    IF QUIT

                           QUIT

 +6                    WRITE @IOF

 +7                    DO HEADER

 +8                    WRITE LINE

                   End DoDot:1

 +9       ;

 +10      IF '$TEST

               IF ('CRT)

                   IF ($Y>(IOSL-2))

                       Begin DoDot:1

 +11                       WRITE @IOF

 +12                       DO HEADER

 +13                       WRITE LINE

                       End DoDot:1

 +14      ;

 +15      IF '$TEST

               WRITE !,LINE

 +16       QUIT

 +17      ;

GETPAT    ;

 +1       ; Description: Gets patients to include in the report

 +2        NEW BEGIN,END,DGARRAY,SDCNT,CATEGORY,DIVISION,NAM

 +3        SET BEGIN=DGENRP("BEGIN")_".0000"

           SET END=DGENRP("END")_".2359"

           SET DGARRAY(1)=BEGIN_";"_END

 +4        SET DGARRAY("FLDS")="3;10"

           SET SDCNT=$$SDAPI^SDAMA301(.DGARRAY)

 +5       ;

 +6       ;there must be subscripts underneath the 101 level to be a

 +7       ;valid appointment, else it is an error eg 01/20/2005

 +8       ; Appointment Database is Unavailable

 +9        IF SDCNT<0

               NEW X

               SET X=$$FAPCHK

               IF X'=""

                   SET NAM=X

                   GOTO ERR

 +10      ;

 +11      ; Get All records for report

 +12       IF DGENRP("ALL")

               Begin DoDot:1

 +13               SET CLINIC=0

FOR

                       SET CLINIC=$ORDER(^TMP($JOB,"SDAMA301",CLINIC))

                       IF 'CLINIC

                           QUIT

                       Begin DoDot:2

 +14                       IF $PIECE($GET(^SC(CLINIC,0)),"^",3)'="C"

                               QUIT

 +15                       SET DFN=0

FOR

                               SET DFN=$ORDER(^TMP($JOB,"SDAMA301",CLINIC,DFN))

                               IF 'DFN

                                   QUIT

                               Begin DoDot:3

 +16                               SET DIVISION=$PIECE($GET(^SC(CLINIC,0)),U,15)

 +17                               IF 'DIVISION

                                       SET DIVISION=$ORDER(^DG(40.8,0))

 +18                               DO VALREC(CLINIC,DFN)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +19      ;

 +20      ; Get records for specified Divisions only

 +21       IF $ORDER(DGENRP("DIVISION",0))

               Begin DoDot:1

 +22               SET CLINIC=0

FOR

                       SET CLINIC=$ORDER(^TMP($JOB,"SDAMA301",CLINIC))

                       IF 'CLINIC

                           QUIT

                       Begin DoDot:2

 +23                       IF $PIECE($GET(^SC(CLINIC,0)),"^",3)'="C"

                               QUIT

 +24                       SET DIVISION=$PIECE($GET(^SC(CLINIC,0)),U,15)

 +25                       IF 'DIVISION

                               SET DIVISION=$ORDER(^DG(40.8,0))

 +26                       IF 'DIVISION!('$DATA(DGENRP("DIVISION",DIVISION)))

                               QUIT

 +27                       SET DFN=0

FOR

                               SET DFN=$ORDER(^TMP($JOB,"SDAMA301",CLINIC,DFN))

                               IF 'DFN

                                   QUIT

                               DO VALREC(CLINIC,DFN)

                       End DoDot:2

               End DoDot:1

 +28      ;

 +29      ; Get records for specified Clinics only

 +30       IF $ORDER(DGENRP("CLINIC",0))

               Begin DoDot:1

 +31               SET CLINIC=0

FOR

                       SET CLINIC=$ORDER(^TMP($JOB,"SDAMA301",CLINIC))

                       IF 'CLINIC

                           QUIT

                       Begin DoDot:2

 +32                       IF 'CLINIC!('$DATA(DGENRP("CLINIC",CLINIC)))

                               QUIT

 +33                       IF ($PIECE($GET(^SC(CLINIC,0)),U,3)'="C")

                               QUIT

 +34                       SET DIVISION=$PIECE($GET(^SC(CLINIC,0)),U,15)

 +35                       IF 'DIVISION

                               SET DIVISION=$ORDER(^DG(40.8,0))

 +36                       SET DFN=0

FOR

                               SET DFN=$ORDER(^TMP($JOB,"SDAMA301",CLINIC,DFN))

                               IF 'DFN

                                   QUIT

                               DO VALREC(CLINIC,DFN)

                       End DoDot:2

               End DoDot:1

 +37      ;

 +38       KILL DGARRAY,^TMP($JOB,"SDAMA301"),SDCNT

 +39       QUIT

 +40      ;

ERR       ;

 +1       ;^TMP($J,TYPE,DIVISION NAME,CLINIC NAME,CATEGORY,APPT DT/TM,DFN)

 +2        IF NAM["Appointment Database is unavailable. Please try again later."

               SET NAM="**Appointment Database is Unavailable**"

 +3        IF NAM["Appointment request contains invalid values."

               SET NAM="**Invalid appointment, call Help Desk**"

 +4        IF NAM["An error has occurred. Check the RSA Error Log."

               SET NAM="**Error,  check RSA Error Log **"

 +5        SET ^TMP($JOB,"NOENREC"," ",NAM," ",DT," ")=""

 +6        KILL DGARRAY,^TMP($JOB,"SDAMA301"),SDCNT,NAM

 +7        QUIT

 +8       ;

VALREC(CLINIC,DFN) ;

 +1       ;

 +2        NEW APPT,STATUS,JUSTONCE

           SET JUSTONCE=0

 +3        SET APPT=0

FOR

               SET APPT=$ORDER(^TMP($JOB,"SDAMA301",CLINIC,DFN,APPT))

               IF 'APPT!(JUSTONCE)

                   QUIT

               Begin DoDot:1

 +4                SET JUSTONCE=+$GET(DGENRP("JUSTONCE"))

 +5       ; Exclude certain appointment statuses

 +6                SET STATUS=$PIECE($PIECE(^TMP($JOB,"SDAMA301",CLINIC,DFN,APPT),U,3),";")

 +7                IF "^NS^NSR^CC^CCR^CP^CPR^"[(U_STATUS_U)

                       QUIT

 +8       ;

 +9       ; Don't include enrolled veterans or ones that have pending apps

 +10               SET CATEGORY=$$CATEGORY^DGENA4(DFN)

 +11               IF (CATEGORY="E")!(CATEGORY="P")

                       QUIT

 +12      ;

 +13      ; Exclude if not an eligible veteran (can not enroll)

 +14               IF '$$VET^DGENPTA(DFN)

                       QUIT

 +15      ;

 +16               DO SETTMP(CLINIC,DFN,APPT)

               End DoDot:1

 +17       QUIT

 +18      ;

SETTMP(CLINIC,DFN,APPT) ;

 +1       ; NOENREC is for patients without enrollment records

 +2       ; SITE2 is for other excluded enrollment records

 +3       ;^TMP($J,TYPE,DIVISION NAME,CLINIC NAME,CATEGORY,APPT DT/TM,DFN)

 +4       ;

 +5        NEW DIVNAME,CLNAME

 +6        SET DIVNAME=$SELECT(DIVISION:$PIECE($$SITE^VASITE(APPT\1,DIVISION),U,2),1:" ")

 +7        SET CLNAME=$PIECE($GET(^SC(CLINIC,0)),"^")

 +8        IF CLNAME=""

               SET CLNAME=" "

 +9       ;

 +10       IF $$FINDCUR^DGENA(DFN)=""

               SET ^TMP($JOB,"NOENREC",DIVNAME,CLNAME,CATEGORY,APPT,DFN)=""

               QUIT

 +11       SET ^TMP($JOB,"STEP2",DIVNAME,CLNAME,CATEGORY,APPT,DFN)=$$STATUS^DGENA(DFN)_U_$PIECE($PIECE(^TMP($JOB,"SDAMA301",CLINIC,DFN,APPT),U,10),";",2)

 +12       QUIT

 +13      ;

HEADER    ;

 +1       ;Description: Prints the report header.

 +2       ;

 +3        NEW LINE

 +4        IF $Y>1

               WRITE @IOF

 +5        WRITE !,"Appointments for Veterans with no Enrollment Application"

 +6        IF DGENRP("BEGIN")

               WRITE ?70,"Date Range: "_$$FMTE^XLFDT(DGENRP("BEGIN"))_" to "_$$FMTE^XLFDT($GET(DGENRP("END")))

 +7        WRITE ?120,"Page ",PAGE

 +8        SET PAGE=PAGE+1

 +9        WRITE !

 +10       WRITE ?70," Run Date: "_$$FMTE^XLFDT(DT)

 +11       WRITE !

 +12      ;

 +13       WRITE !,"Name",?39,"PatientID",?57,"DOB",?70,"Appt Dt/Tm",?90,"EnrollStatus",?121,"Enroll Cat"

 +14       SET $PIECE(LINE,"-",132)="-"

 +15       WRITE !,LINE,!

 +16       QUIT

 +17      ;

PAUSE     ;

 +1       ;Description: Screen pause.  Sets QUIT=1 if user decides to quit.

 +2       ;

 +3        NEW DIR,X,Y

 +4        FOR

               IF $Y>(IOSL-3)

                   QUIT

               WRITE !

 +5        SET DIR(0)="E"

 +6        DO ^DIR

 +7        IF ('(+Y))!$DATA(DIRUT)

               SET QUIT=1

 +8        QUIT

 +9       ;

PATIENTS(SUBSCRPT) ;

 +1       ;Description: Prints list of patients

 +2       ;

 +3        NEW NODE,DIVISION,CLINIC,TIME,PATIENT,DGPAT,APPTYPE,ENRSTAT,CATEGORY

 +4       ;

 +5       ;

 +6        SET DIVISION=""

 +7        FOR

               SET DIVISION=$ORDER(^TMP($JOB,SUBSCRPT,DIVISION))

               IF DIVISION=""

                   QUIT

               Begin DoDot:1

 +8                DO LINE("  ")

                   IF QUIT

                       QUIT

 +9                DO LINE($$LJ(" ",40)_"DIVISION: "_DIVISION)

                   IF QUIT

                       QUIT

 +10               DO LINE("  ")

                   IF QUIT

                       QUIT

 +11               SET CLINIC=""

 +12               FOR

                       SET CLINIC=$ORDER(^TMP($JOB,SUBSCRPT,DIVISION,CLINIC))

                       IF CLINIC=""

                           QUIT

                       Begin DoDot:2

 +13                       DO LINE("  ")

                           IF QUIT

                               QUIT

 +14                       DO LINE("CLINIC: "_$$LJ(CLINIC,40)_$$LJ(" ",40)_"DIVISION: "_DIVISION)

 +15                       IF QUIT

                               QUIT

 +16                       SET CATEGORY=""

 +17                       FOR

                               SET CATEGORY=$ORDER(^TMP($JOB,SUBSCRPT,DIVISION,CLINIC,CATEGORY))

                               IF CATEGORY=""

                                   QUIT

                               Begin DoDot:3

 +18                               DO LINE(" ")

                                   IF QUIT

                                       QUIT

 +19                               SET TIME=0

 +20                               FOR

                                       SET TIME=$ORDER(^TMP($JOB,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME))

                                       IF 'TIME

                                           QUIT

                                       Begin DoDot:4

 +21                                       SET DFN=0

 +22                                       FOR

                                               SET DFN=$ORDER(^TMP($JOB,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME,DFN))

                                               IF 'DFN

                                                   QUIT

                                               Begin DoDot:5

 +23                                               SET NODE=$GET(^TMP($JOB,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME,DFN))

 +24                                               SET ENRSTAT=$PIECE(NODE,"^")

 +25                                               SET APPTYPE=$PIECE(NODE,"^",2)

 +26                                               IF '$$GET^DGENPTA(DFN,.DGPAT)

                                                       QUIT

 +27                                               SET LINE=$$LJ(DGPAT("NAME"),37)_" "_$$LJ(DGPAT("PID"),15)_" "

 +28                                               SET LINE=LINE_$$LJ($$DATE(DGPAT("DOB")),12)_"  "

 +29                                               SET LINE=LINE_$$LJ($$DATE(TIME),20)

 +30                                               SET LINE=LINE_"  "_$$LJ($SELECT(ENRSTAT="":"NO ENROLLMENT RECORD",1:$$EXT^DGENU("STATUS",ENRSTAT)),28)

 +31                                               SET LINE=LINE_$$LJ(" ",2)_$$EXTCAT^DGENA4(CATEGORY)

 +32                                               DO LINE(LINE)

 +33                                               IF QUIT

                                                       QUIT

                                               End DoDot:5

                                               IF QUIT

                                                   QUIT

                                       End DoDot:4

                                       IF QUIT

                                           QUIT

                               End DoDot:3

                               IF QUIT

                                   QUIT

                       End DoDot:2

                       IF QUIT

                           QUIT

               End DoDot:1

               IF QUIT

                   QUIT

 +34       QUIT

 +35      ;

DATE(DATE) ;

 +1        QUIT $$FMTE^XLFDT(DATE,"1")

 +2       ;

LJ(STRING,LENGTH) ;

 +1        QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LENGTH),LENGTH)

 +2       ;

FAPCHK()  ;

 +1        NEW ERR

 +2        SET ERR=$ORDER(^TMP($JOB,"SDAMA301",""))

 +3        IF $DATA(^TMP($JOB,"SDAMA301",ERR))=1

               QUIT ^TMP($JOB,"SDAMA301",ERR)

 +4        QUIT ""

DGENRPD2.m