DGENRPC2 ;ALB/CJM -Enrollees by Status, Priority, Preferred Facility Report - Continued; May 12, 1999
;;5.3;Registration;**147,232,306**;Aug 13,1993
;
PRINT ;
N STATS,CRT,QUIT,PAGE,SECTION
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
S SECTION="SUMMARY"
D HEADER
D SUMMARY
I DGENRP("LIST") D
.S SECTION="PATIENTS"
.D HEADER
.D PATIENTS
I CRT,'QUIT D PAUSE
I $D(ZTQUEUED) S ZTREQ="@"
D ^%ZISC
K ^TMP($J)
Q
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
Q
;
GETPAT ;
;Description: Gets patients to include in the report
;for that reason
;
N DFN,STATUS
S STATUS=0
F S STATUS=$O(^DPT("AENRC",STATUS)) Q:'STATUS D
.S DFN=0
.F S DFN=$O(^DPT("AENRC",STATUS,DFN)) Q:'DFN D
..N DGINST,DGPFH,PREFAC,DGENRIEN,DGENR,EFFDATE,FACNAME,PATNAME,CATEGORY,PRISUB
..S FACNAME=" "
..S DGENRIEN=$$FINDCUR^DGENA(DFN)
..S CATEGORY=$$CATEGORY^DGENA4(DFN,STATUS)
..Q:'$$GET^DGENA(DGENRIEN,.DGENR)
..Q:DGENR("STATUS")'=STATUS
..S PATNAME=$$NAME^DGENPTA(DFN)
..S DGENR("SUBGRP")=$$EXT^DGENU("SUBGRP",DGENR("SUBGRP"))
..Q:(PATNAME="")
..;
..S PREFAC=$$PREF^DGENPTA(DFN)
..I PREFAC S DGPFH("PREFAC")=PREFAC,DGPFH("EFFDATE")=""
..I PREFAC,'$$GETINST^DGENU($G(DGPFH("PREFAC")),.DGINST) S PREFAC=""
..I (DGENRP("FACILITY","ALL")!$D(DGENRP("FACILITY",+PREFAC))) D
...S PRISUB=+DGENR("PRIORITY")_DGENR("SUBGRP")
...S:PREFAC FACNAME=$$LJ($G(DGINST("STANUM")),10)_$$LJ($G(DGINST("NAME")),45)
...S ^TMP($J,FACNAME,CATEGORY,DGENR("STATUS"))=$G(^TMP($J,FACNAME,CATEGORY,DGENR("STATUS")))+1
...S ^TMP($J,FACNAME,CATEGORY,DGENR("STATUS"),PRISUB)=$G(^TMP($J,FACNAME,CATEGORY,DGENR("STATUS"),PRISUB))+1
...I DGENRP("LIST"),DGENRP("STATUS","ALL")!$D(DGENRP("STATUS",STATUS)),DGENRP("PRIORITY","ALL")!$D(DGENRP("PRIORITY",+DGENR("PRIORITY"))) D
....S ^TMP($J,FACNAME,"PATIENT",CATEGORY,DGENR("STATUS"),PRISUB,$E(PATNAME,1,45),+DGENR("DATE"),+DGENR("DFN"))=DGENRIEN_"^"_$G(DGINST("STANUM"))_"^"_$G(DGPFH("EFFDATE"))
Q
;
;Description: Prints the report header.
;
N LINE
I $Y>1 W @IOF
W !,"Enrollments by Status, Priority, and Preferred Facility"
W ?100,"Page ",PAGE
S PAGE=PAGE+1
;
W !
W $S(SECTION="SUMMARY":" <<< SUMMARY STATISTICS >>>",1:" <<< PATIENT LISTING >>>")
W ?100,"Run Date: "_$$FMTE^XLFDT(DT)
W !
I SECTION="PATIENTS",DGENRP("LIST") D
.W !,"Selection Criteria for Patient Listing: "
.W !?5,"Enrollment Statuses: "
.I DGENRP("STATUS","ALL") D
..W "ALL"
.E D
..N STATUS
..S STATUS=""
..F S STATUS=$O(DGENRP("STATUS",STATUS)) Q:'STATUS W $$EXT^DGENU("STATUS",STATUS)_","
.;
.W !?5,"Enrollment Priorities: "
.I DGENRP("PRIORITY","ALL") D
..W "ALL"
.E D
..N PRIORITY
..S PRIORITY=""
..F S PRIORITY=$O(DGENRP("PRIORITY",PRIORITY)) Q:'PRIORITY W PRIORITY_", "
W:(SECTION="PATIENTS") !,"Name",?39,"PatientID",?54,"DOB",?67,"Status",?86,"Priority",?101,"EnrollDate",?114,"EndDate",?129
S $P(LINE,"-",132)="-"
W !,LINE,!
Q
;
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
Q
;
SUMMARY ;
;Description: Prints the summary statistics
;
N PREFAC,LINE,PRIORITY,STATUS,TOTAL,COUNT,GRNDTOTL
S PREFAC=""
S GRNDTOTL=0
F S PREFAC=$O(^TMP($J,PREFAC)) Q:PREFAC="" D Q:QUIT
.D LINE(" ") Q:QUIT
.D LINE($$LJ(" ",40)_"PREFERRED FACILITY: "_$S(PREFAC=" ":"none",1:PREFAC)_" "_$G(^TMP($J,PREFAC))) Q:QUIT
.D LINE($$LJ(" ",55)_"Enr. Category") Q:QUIT
.S TOTAL=0
.S CATEGORY=""
.F S CATEGORY=$O(^TMP($J,PREFAC,CATEGORY)) Q:CATEGORY="" D Q:QUIT
..D LINE($$LJ(" ",58)_$$EXTCAT^DGENA4(CATEGORY))
..S STATUS=""
..F S STATUS=$O(^TMP($J,PREFAC,CATEGORY,STATUS)) Q:'STATUS D Q:QUIT
...S COUNT=$G(^TMP($J,PREFAC,CATEGORY,STATUS))
...S TOTAL=TOTAL+COUNT
...D LINE(" "_$$LJ($$STATUS(STATUS),18)_" "_$J(COUNT,7))
...Q:QUIT
...S PRIORITY=""
...F S PRIORITY=$O(^TMP($J,PREFAC,CATEGORY,STATUS,PRIORITY)) Q:(PRIORITY="") D Q:QUIT
....S COUNT=$G(^TMP($J,PREFAC,CATEGORY,STATUS,PRIORITY))
....I $L(PRIORITY)=2 D LINE(" Priority "_+PRIORITY_$E(PRIORITY,2)_" "_$J(COUNT,7)) Q
....D LINE(" "_$S(PRIORITY:"Priority "_PRIORITY_" ",1:"No Priority ")_$J(COUNT,7))
...Q:QUIT
...D LINE(" ")
..Q:QUIT
.Q:QUIT
.S GRNDTOTL=GRNDTOTL+TOTAL
.D:(PREFAC=" ") LINE(" TOTAL (NO FACILITY) "_$J(TOTAL,8))
.D:(PREFAC'=" ") LINE(" FACILITY TOTAL "_$J(TOTAL,8))
.Q:QUIT
Q:QUIT
W !!
D LINE(" TOTAL FOR ALL SELECTED FACILITIES: "_$J(GRNDTOTL,8))
Q:QUIT
Q
;
PATIENTS ;
;Description: Prints list of patients
;
N PREFAC,DGENRIEN,DGENR,DGPAT,LINE,NODE,PATNAME,STATUS,PRIORITY,ENRDATE,DFN,CATEGORY,I
;
S PREFAC=""
;
F S PREFAC=$O(^TMP($J,PREFAC)) Q:PREFAC="" D Q:QUIT
.D LINE(" ") Q:QUIT
.D LINE($$LJ(" ",40)_"PREFERRED FACILITY: "_$S(PREFAC=" ":"none",1:PREFAC)_" "_$G(^TMP($J,PREFAC))) Q:QUIT
.S CATEGORY=""
.F I=1:1 S CATEGORY=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY)) Q:CATEGORY="" D Q:QUIT
..D:I>1 LINE(" ") Q:QUIT
..D LINE($$LJ(" ",40)_"ENROLLMENT CATEGORY: "_$$EXTCAT^DGENA4(CATEGORY))
..D LINE(" ") Q:QUIT
..S STATUS=""
..F S STATUS=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS)) Q:'STATUS D Q:QUIT
...S PRIORITY=""
...F S PRIORITY=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY)) Q:(PRIORITY="") D Q:QUIT
....S PATNAME=0
....F S PATNAME=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME)) Q:(PATNAME="") D Q:QUIT
.....S ENRDATE=""
.....F S ENRDATE=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE)) Q:ENRDATE="" D Q:QUIT
......S DFN=0
......F S DFN=$O(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE,DFN)) Q:'DFN D Q:QUIT
.......;
.......S NODE=$G(^TMP($J,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE,DFN))
.......S DGENRIEN=$P(NODE,"^")
.......Q:'DGENRIEN
.......Q:'$$GET^DGENA(DGENRIEN,.DGENR)
.......Q:'$$GET^DGENPTA(DGENR("DFN"),.DGPAT)
.......S LINE=$$LJ(DGPAT("NAME"),37)_" "_$$LJ(DGPAT("PID"),15)_" "
.......S LINE=LINE_$$LJ($$DATE(DGPAT("DOB")),12)_" "
.......S LINE=LINE_$$LJ($$EXT^DGENU("STATUS",DGENR("STATUS")),17)_" "
.......S LINE=LINE_$$LJ(" "_DGENR("PRIORITY")_$S(DGENR("SUBGRP"):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:""),15)_" "
.......S LINE=LINE_$$LJ($$DATE(DGENR("DATE")),12)_" "
.......S LINE=LINE_$$LJ($$DATE(DGENR("END")),12)_" "
.......D LINE(LINE)
.......Q:QUIT
.Q:QUIT
Q
;
STATUS(STATUS) ;
;Description: Returns status name.
;
Q:'STATUS "No Status"
Q $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
;
DATE(DATE) ;
Q $$FMTE^XLFDT(DATE,"1")
;
LJ(STRING,LENGTH) ;
Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENRPC2 7061 printed Nov 22, 2024@17:53:02 Page 2
DGENRPC2 ;ALB/CJM -Enrollees by Status, Priority, Preferred Facility Report - Continued; May 12, 1999
+1 ;;5.3;Registration;**147,232,306**;Aug 13,1993
+2 ;
PRINT ;
+1 NEW STATS,CRT,QUIT,PAGE,SECTION
+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 SET SECTION="SUMMARY"
+12 DO HEADER
+13 DO SUMMARY
+14 IF DGENRP("LIST")
Begin DoDot:1
+15 SET SECTION="PATIENTS"
+16 DO HEADER
+17 DO PATIENTS
End DoDot:1
+18 IF CRT
IF 'QUIT
DO PAUSE
+19 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+20 DO ^%ZISC
+21 KILL ^TMP($JOB)
+22 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 ;for that reason
+3 ;
+4 NEW DFN,STATUS
+5 SET STATUS=0
+6 FOR
SET STATUS=$ORDER(^DPT("AENRC",STATUS))
if 'STATUS
QUIT
Begin DoDot:1
+7 SET DFN=0
+8 FOR
SET DFN=$ORDER(^DPT("AENRC",STATUS,DFN))
if 'DFN
QUIT
Begin DoDot:2
+9 NEW DGINST,DGPFH,PREFAC,DGENRIEN,DGENR,EFFDATE,FACNAME,PATNAME,CATEGORY,PRISUB
+10 SET FACNAME=" "
+11 SET DGENRIEN=$$FINDCUR^DGENA(DFN)
+12 SET CATEGORY=$$CATEGORY^DGENA4(DFN,STATUS)
+13 if '$$GET^DGENA(DGENRIEN,.DGENR)
QUIT
+14 if DGENR("STATUS")'=STATUS
QUIT
+15 SET PATNAME=$$NAME^DGENPTA(DFN)
+16 SET DGENR("SUBGRP")=$$EXT^DGENU("SUBGRP",DGENR("SUBGRP"))
+17 if (PATNAME="")
QUIT
+18 ;
+19 SET PREFAC=$$PREF^DGENPTA(DFN)
+20 IF PREFAC
SET DGPFH("PREFAC")=PREFAC
SET DGPFH("EFFDATE")=""
+21 IF PREFAC
IF '$$GETINST^DGENU($GET(DGPFH("PREFAC")),.DGINST)
SET PREFAC=""
+22 IF (DGENRP("FACILITY","ALL")!$DATA(DGENRP("FACILITY",+PREFAC)))
Begin DoDot:3
+23 SET PRISUB=+DGENR("PRIORITY")_DGENR("SUBGRP")
+24 if PREFAC
SET FACNAME=$$LJ($GET(DGINST("STANUM")),10)_$$LJ($GET(DGINST("NAME")),45)
+25 SET ^TMP($JOB,FACNAME,CATEGORY,DGENR("STATUS"))=$GET(^TMP($JOB,FACNAME,CATEGORY,DGENR("STATUS")))+1
+26 SET ^TMP($JOB,FACNAME,CATEGORY,DGENR("STATUS"),PRISUB)=$GET(^TMP($JOB,FACNAME,CATEGORY,DGENR("STATUS"),PRISUB))+1
+27 IF DGENRP("LIST")
IF DGENRP("STATUS","ALL")!$DATA(DGENRP("STATUS",STATUS))
IF DGENRP("PRIORITY","ALL")!$DATA(DGENRP("PRIORITY",+DGENR("PRIORITY")))
Begin DoDot:4
+28 SET ^TMP($JOB,FACNAME,"PATIENT",CATEGORY,DGENR("STATUS"),PRISUB,$EXTRACT(PATNAME,1,45),+DGENR("DATE"),+DGENR("DFN"))=DGENRIEN_"^"_$GET(DGINST("STANUM"))_"^"_$GET(DGPFH("EFFDATE"))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
+1 ;Description: Prints the report header.
+2 ;
+3 NEW LINE
+4 IF $Y>1
WRITE @IOF
+5 WRITE !,"Enrollments by Status, Priority, and Preferred Facility"
+6 WRITE ?100,"Page ",PAGE
+7 SET PAGE=PAGE+1
+8 ;
+9 WRITE !
+10 WRITE $SELECT(SECTION="SUMMARY":" <<< SUMMARY STATISTICS >>>",1:" <<< PATIENT LISTING >>>")
+11 WRITE ?100,"Run Date: "_$$FMTE^XLFDT(DT)
+12 WRITE !
+13 IF SECTION="PATIENTS"
IF DGENRP("LIST")
Begin DoDot:1
+14 WRITE !,"Selection Criteria for Patient Listing: "
+15 WRITE !?5,"Enrollment Statuses: "
+16 IF DGENRP("STATUS","ALL")
Begin DoDot:2
+17 WRITE "ALL"
End DoDot:2
+18 IF '$TEST
Begin DoDot:2
+19 NEW STATUS
+20 SET STATUS=""
+21 FOR
SET STATUS=$ORDER(DGENRP("STATUS",STATUS))
if 'STATUS
QUIT
WRITE $$EXT^DGENU("STATUS",STATUS)_","
End DoDot:2
+22 ;
+23 WRITE !?5,"Enrollment Priorities: "
+24 IF DGENRP("PRIORITY","ALL")
Begin DoDot:2
+25 WRITE "ALL"
End DoDot:2
+26 IF '$TEST
Begin DoDot:2
+27 NEW PRIORITY
+28 SET PRIORITY=""
+29 FOR
SET PRIORITY=$ORDER(DGENRP("PRIORITY",PRIORITY))
if 'PRIORITY
QUIT
WRITE PRIORITY_", "
End DoDot:2
End DoDot:1
+30 if (SECTION="PATIENTS")
WRITE !,"Name",?39,"PatientID",?54,"DOB",?67,"Status",?86,"Priority",?101,"EnrollDate",?114,"EndDate",?129
+31 SET $PIECE(LINE,"-",132)="-"
+32 WRITE !,LINE,!
+33 QUIT
+34 ;
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 ;
SUMMARY ;
+1 ;Description: Prints the summary statistics
+2 ;
+3 NEW PREFAC,LINE,PRIORITY,STATUS,TOTAL,COUNT,GRNDTOTL
+4 SET PREFAC=""
+5 SET GRNDTOTL=0
+6 FOR
SET PREFAC=$ORDER(^TMP($JOB,PREFAC))
if PREFAC=""
QUIT
Begin DoDot:1
+7 DO LINE(" ")
if QUIT
QUIT
+8 DO LINE($$LJ(" ",40)_"PREFERRED FACILITY: "_$SELECT(PREFAC=" ":"none",1:PREFAC)_" "_$GET(^TMP($JOB,PREFAC)))
if QUIT
QUIT
+9 DO LINE($$LJ(" ",55)_"Enr. Category")
if QUIT
QUIT
+10 SET TOTAL=0
+11 SET CATEGORY=""
+12 FOR
SET CATEGORY=$ORDER(^TMP($JOB,PREFAC,CATEGORY))
if CATEGORY=""
QUIT
Begin DoDot:2
+13 DO LINE($$LJ(" ",58)_$$EXTCAT^DGENA4(CATEGORY))
+14 SET STATUS=""
+15 FOR
SET STATUS=$ORDER(^TMP($JOB,PREFAC,CATEGORY,STATUS))
if 'STATUS
QUIT
Begin DoDot:3
+16 SET COUNT=$GET(^TMP($JOB,PREFAC,CATEGORY,STATUS))
+17 SET TOTAL=TOTAL+COUNT
+18 DO LINE(" "_$$LJ($$STATUS(STATUS),18)_" "_$JUSTIFY(COUNT,7))
+19 if QUIT
QUIT
+20 SET PRIORITY=""
+21 FOR
SET PRIORITY=$ORDER(^TMP($JOB,PREFAC,CATEGORY,STATUS,PRIORITY))
if (PRIORITY="")
QUIT
Begin DoDot:4
+22 SET COUNT=$GET(^TMP($JOB,PREFAC,CATEGORY,STATUS,PRIORITY))
+23 IF $LENGTH(PRIORITY)=2
DO LINE(" Priority "_+PRIORITY_$EXTRACT(PRIORITY,2)_" "_$JUSTIFY(COUNT,7))
QUIT
+24 DO LINE(" "_$SELECT(PRIORITY:"Priority "_PRIORITY_" ",1:"No Priority ")_$JUSTIFY(COUNT,7))
End DoDot:4
if QUIT
QUIT
+25 if QUIT
QUIT
+26 DO LINE(" ")
End DoDot:3
if QUIT
QUIT
+27 if QUIT
QUIT
End DoDot:2
if QUIT
QUIT
+28 if QUIT
QUIT
+29 SET GRNDTOTL=GRNDTOTL+TOTAL
+30 if (PREFAC=" ")
DO LINE(" TOTAL (NO FACILITY) "_$JUSTIFY(TOTAL,8))
+31 if (PREFAC'=" ")
DO LINE(" FACILITY TOTAL "_$JUSTIFY(TOTAL,8))
+32 if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+33 if QUIT
QUIT
+34 WRITE !!
+35 DO LINE(" TOTAL FOR ALL SELECTED FACILITIES: "_$JUSTIFY(GRNDTOTL,8))
+36 if QUIT
QUIT
+37 QUIT
+38 ;
PATIENTS ;
+1 ;Description: Prints list of patients
+2 ;
+3 NEW PREFAC,DGENRIEN,DGENR,DGPAT,LINE,NODE,PATNAME,STATUS,PRIORITY,ENRDATE,DFN,CATEGORY,I
+4 ;
+5 SET PREFAC=""
+6 ;
+7 FOR
SET PREFAC=$ORDER(^TMP($JOB,PREFAC))
if PREFAC=""
QUIT
Begin DoDot:1
+8 DO LINE(" ")
if QUIT
QUIT
+9 DO LINE($$LJ(" ",40)_"PREFERRED FACILITY: "_$SELECT(PREFAC=" ":"none",1:PREFAC)_" "_$GET(^TMP($JOB,PREFAC)))
if QUIT
QUIT
+10 SET CATEGORY=""
+11 FOR I=1:1
SET CATEGORY=$ORDER(^TMP($JOB,PREFAC,"PATIENT",CATEGORY))
if CATEGORY=""
QUIT
Begin DoDot:2
+12 if I>1
DO LINE(" ")
if QUIT
QUIT
+13 DO LINE($$LJ(" ",40)_"ENROLLMENT CATEGORY: "_$$EXTCAT^DGENA4(CATEGORY))
+14 DO LINE(" ")
if QUIT
QUIT
+15 SET STATUS=""
+16 FOR
SET STATUS=$ORDER(^TMP($JOB,PREFAC,"PATIENT",CATEGORY,STATUS))
if 'STATUS
QUIT
Begin DoDot:3
+17 SET PRIORITY=""
+18 FOR
SET PRIORITY=$ORDER(^TMP($JOB,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY))
if (PRIORITY="")
QUIT
Begin DoDot:4
+19 SET PATNAME=0
+20 FOR
SET PATNAME=$ORDER(^TMP($JOB,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME))
if (PATNAME="")
QUIT
Begin DoDot:5
+21 SET ENRDATE=""
+22 FOR
SET ENRDATE=$ORDER(^TMP($JOB,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE))
if ENRDATE=""
QUIT
Begin DoDot:6
+23 SET DFN=0
+24 FOR
SET DFN=$ORDER(^TMP($JOB,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE,DFN))
if 'DFN
QUIT
Begin DoDot:7
+25 ;
+26 SET NODE=$GET(^TMP($JOB,PREFAC,"PATIENT",CATEGORY,STATUS,PRIORITY,PATNAME,ENRDATE,DFN))
+27 SET DGENRIEN=$PIECE(NODE,"^")
+28 if 'DGENRIEN
QUIT
+29 if '$$GET^DGENA(DGENRIEN,.DGENR)
QUIT
+30 if '$$GET^DGENPTA(DGENR("DFN"),.DGPAT)
QUIT
+31 SET LINE=$$LJ(DGPAT("NAME"),37)_" "_$$LJ(DGPAT("PID"),15)_" "
+32 SET LINE=LINE_$$LJ($$DATE(DGPAT("DOB")),12)_" "
+33 SET LINE=LINE_$$LJ($$EXT^DGENU("STATUS",DGENR("STATUS")),17)_" "
+34 SET LINE=LINE_$$LJ(" "_DGENR("PRIORITY")_$SELECT(DGENR("SUBGRP"):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:""),15)_" "
+35 SET LINE=LINE_$$LJ($$DATE(DGENR("DATE")),12)_" "
+36 SET LINE=LINE_$$LJ($$DATE(DGENR("END")),12)_" "
+37 DO LINE(LINE)
+38 if QUIT
QUIT
End DoDot:7
if QUIT
QUIT
End DoDot:6
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
+39 if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+40 QUIT
+41 ;
STATUS(STATUS) ;
+1 ;Description: Returns status name.
+2 ;
+3 if 'STATUS
QUIT "No Status"
+4 QUIT $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
+5 ;
DATE(DATE) ;
+1 QUIT $$FMTE^XLFDT(DATE,"1")
+2 ;
LJ(STRING,LENGTH) ;
+1 QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LENGTH),LENGTH)
