DGENRPB2 ;ALB/CJM - Pending Applications for Enrollment Report Cont.; May 4, 1998
;;5.3;Registration;**147,232**;Aug 13,1993
;
PRINT ;
N STATS,CRT,QUIT,PAGE1
K ^TMP($J)
S QUIT=0
S PAGE1=1
S CRT=$S($E(IOST,1,2)="C-":1,1:0)
;
D GETPAT
U IO
I CRT,PAGE1 W @IOF S PAGE1=0
D HEADER
;
D PRNTPATS
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,I,DGENRIEN,DGENR,EFFDATE
S STATUS=""
F S STATUS=$O(^DPT("AENRC",STATUS)) Q:STATUS="" D
.S DFN=0
.F S DFN=$O(^DPT("AENRC",STATUS,DFN)) Q:'DFN D
..S DGENRIEN=$$FINDCUR^DGENA(DFN)
..Q:'$$GET^DGENA(DGENRIEN,.DGENR)
..I $$CATEGORY^DGENA4(DFN)="P" D
...;
...N PREFAC,DGPFH,DGINST
...S PREFAC=$$PREF^DGENPTA(DFN)
...I PREFAC S DGPFH("PREFAC")=PREFAC,DGPFH("EFFDATE")=""
...I PREFAC,'$$GETINST^DGENU($G(DGPFH("PREFAC")),.DGINST) S PREFAC=""
...I (DGENINST("ALL")!$D(DGENINST(+PREFAC))),(DGENR("APP")>(DGENBEG-1)),(DGENR("APP")<(DGENEND+1)) D
....S ^TMP($J,$$LJ($G(DGINST("STANUM")),10)_$$LJ($G(DGINST("NAME")),45),DGENR("STATUS"),DGENR("APP"),DGENRIEN)=$G(DGPFH("EFFDATE"))
Q
;
;Description: Prints the report header.
;
N LINE
W !,"Pending Applications For Enrollment - Enrollment Category is ""In Process"""
W !,"Date Range: "_$$FMTE^XLFDT(DGENBEG)_" to "_$$FMTE^XLFDT(DGENEND)
W ?50," Run Date: "_$$FMTE^XLFDT(DT)
W !
W !,"AppDt",?17,"Name",?64,"PatientID",?81,"DOB"
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
;
PRNTPATS ;
;Description: Prints list of patients
;
N PREFAC,APP,DGENRIEN,DGENR,DGPAT,LINE,STATUS
S PREFAC=""
F S PREFAC=$O(^TMP($J,PREFAC)) Q:PREFAC="" D Q:QUIT
.D LINE(" ") Q:QUIT
.D LINE("PREFERRED FACILITY: "_$S('(+PREFAC):"none",1:PREFAC)_" "_$G(^TMP($J,PREFAC))) Q:QUIT
.S STATUS=""
.F S STATUS=$O(^TMP($J,PREFAC,STATUS)) Q:STATUS="" D
..D LINE(" ") Q:QUIT
..D LINE(" ENROLLMENT STATUS: "_$$STATUS(STATUS)) Q:QUIT
..S APP=""
..F S APP=$O(^TMP($J,PREFAC,STATUS,APP)) Q:'APP D Q:QUIT
...S DGENRIEN=0
...F S DGENRIEN=$O(^TMP($J,PREFAC,STATUS,APP,DGENRIEN)) Q:'DGENRIEN D Q:QUIT
....Q:'$$GET^DGENA(DGENRIEN,.DGENR)
....Q:'$$GET^DGENPTA(DGENR("DFN"),.DGPAT)
....S LINE=$$LJ($$DATE(APP),12)_" "_$$LJ(DGPAT("NAME"),45)_" "
....S LINE=LINE_$$LJ(DGPAT("PID"),15)_" "_$$LJ($$DATE(DGPAT("DOB")),12)
....D LINE(LINE)
Q
;
STATUS(STATUS) ;
;Description: Returns status name.
;
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[HDGENRPB2 3105 printed Apr 09, 2024@21:38:13 Page 2
DGENRPB2 ;ALB/CJM - Pending Applications for Enrollment Report Cont.; May 4, 1998
+1 ;;5.3;Registration;**147,232**;Aug 13,1993
+2 ;
PRINT ;
+1 NEW STATS,CRT,QUIT,PAGE1
+2 KILL ^TMP($JOB)
+3 SET QUIT=0
+4 SET PAGE1=1
+5 SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+6 ;
+7 DO GETPAT
+8 USE IO
+9 IF CRT
IF PAGE1
WRITE @IOF
SET PAGE1=0
+10 DO HEADER
+11 ;
+12 DO PRNTPATS
+13 IF CRT
IF 'QUIT
DO PAUSE
+14 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+15 DO ^%ZISC
+16 KILL ^TMP($JOB)
+17 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,I,DGENRIEN,DGENR,EFFDATE
+5 SET STATUS=""
+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 SET DGENRIEN=$$FINDCUR^DGENA(DFN)
+10 if '$$GET^DGENA(DGENRIEN,.DGENR)
QUIT
+11 IF $$CATEGORY^DGENA4(DFN)="P"
Begin DoDot:3
+12 ;
+13 NEW PREFAC,DGPFH,DGINST
+14 SET PREFAC=$$PREF^DGENPTA(DFN)
+15 IF PREFAC
SET DGPFH("PREFAC")=PREFAC
SET DGPFH("EFFDATE")=""
+16 IF PREFAC
IF '$$GETINST^DGENU($GET(DGPFH("PREFAC")),.DGINST)
SET PREFAC=""
+17 IF (DGENINST("ALL")!$DATA(DGENINST(+PREFAC)))
IF (DGENR("APP")>(DGENBEG-1))
IF (DGENR("APP")<(DGENEND+1))
Begin DoDot:4
+18 SET ^TMP($JOB,$$LJ($GET(DGINST("STANUM")),10)_$$LJ($GET(DGINST("NAME")),45),DGENR("STATUS"),DGENR("APP"),DGENRIEN)=$GET(DGPFH("EFFDATE"))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+1 ;Description: Prints the report header.
+2 ;
+3 NEW LINE
+4 WRITE !,"Pending Applications For Enrollment - Enrollment Category is ""In Process"""
+5 WRITE !,"Date Range: "_$$FMTE^XLFDT(DGENBEG)_" to "_$$FMTE^XLFDT(DGENEND)
+6 WRITE ?50," Run Date: "_$$FMTE^XLFDT(DT)
+7 WRITE !
+8 WRITE !,"AppDt",?17,"Name",?64,"PatientID",?81,"DOB"
+9 SET $PIECE(LINE,"-",132)="-"
+10 WRITE !,LINE
+11 QUIT
+12 ;
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"
DO ^DIR
+6 IF ('(+Y))!$DATA(DIRUT)
SET QUIT=1
+7 QUIT
+8 ;
PRNTPATS ;
+1 ;Description: Prints list of patients
+2 ;
+3 NEW PREFAC,APP,DGENRIEN,DGENR,DGPAT,LINE,STATUS
+4 SET PREFAC=""
+5 FOR
SET PREFAC=$ORDER(^TMP($JOB,PREFAC))
if PREFAC=""
QUIT
Begin DoDot:1
+6 DO LINE(" ")
if QUIT
QUIT
+7 DO LINE("PREFERRED FACILITY: "_$SELECT('(+PREFAC):"none",1:PREFAC)_" "_$GET(^TMP($JOB,PREFAC)))
if QUIT
QUIT
+8 SET STATUS=""
+9 FOR
SET STATUS=$ORDER(^TMP($JOB,PREFAC,STATUS))
if STATUS=""
QUIT
Begin DoDot:2
+10 DO LINE(" ")
if QUIT
QUIT
+11 DO LINE(" ENROLLMENT STATUS: "_$$STATUS(STATUS))
if QUIT
QUIT
+12 SET APP=""
+13 FOR
SET APP=$ORDER(^TMP($JOB,PREFAC,STATUS,APP))
if 'APP
QUIT
Begin DoDot:3
+14 SET DGENRIEN=0
+15 FOR
SET DGENRIEN=$ORDER(^TMP($JOB,PREFAC,STATUS,APP,DGENRIEN))
if 'DGENRIEN
QUIT
Begin DoDot:4
+16 if '$$GET^DGENA(DGENRIEN,.DGENR)
QUIT
+17 if '$$GET^DGENPTA(DGENR("DFN"),.DGPAT)
QUIT
+18 SET LINE=$$LJ($$DATE(APP),12)_" "_$$LJ(DGPAT("NAME"),45)_" "
+19 SET LINE=LINE_$$LJ(DGPAT("PID"),15)_" "_$$LJ($$DATE(DGPAT("DOB")),12)
+20 DO LINE(LINE)
End DoDot:4
if QUIT
QUIT
End DoDot:3
if QUIT
QUIT
End DoDot:2
End DoDot:1
if QUIT
QUIT
+21 QUIT
+22 ;
STATUS(STATUS) ;
+1 ;Description: Returns status name.
+2 ;
+3 QUIT $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
+4 ;
DATE(DATE) ;
+1 QUIT $$FMTE^XLFDT(DATE,"1")
+2 ;
LJ(STRING,LENGTH) ;
+1 QUIT $$LJ^XLFSTR($EXTRACT(STRING,1,LENGTH),LENGTH)
