- 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 Jan 18, 2025@03:43:43 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)