- DGENRPC2 ;ALB/CJM -Enrollees by Status, Priority, Preferred Facility Report - Continued; May 12, 1999
- ;;5.3;Registration;**147,232,306,1015**;Aug 13,1993;Build 21
- ;
- 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)
- DGENRPC2 ;ALB/CJM -Enrollees by Status, Priority, Preferred Facility Report - Continued; May 12, 1999
- +1 ;;5.3;Registration;**147,232,306,1015**;Aug 13,1993;Build 21
- +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)
