1 | DGENRPB2 ;ALB/CJM - Pending Applications for Enrollment Report Cont.; May 4, 1998
|
---|
2 | ;;5.3;Registration;**147,232**;Aug 13,1993
|
---|
3 | ;
|
---|
4 | PRINT ;
|
---|
5 | N STATS,CRT,QUIT,PAGE1
|
---|
6 | K ^TMP($J)
|
---|
7 | S QUIT=0
|
---|
8 | S PAGE1=1
|
---|
9 | S CRT=$S($E(IOST,1,2)="C-":1,1:0)
|
---|
10 | ;
|
---|
11 | D GETPAT
|
---|
12 | U IO
|
---|
13 | I CRT,PAGE1 W @IOF S PAGE1=0
|
---|
14 | D HEADER
|
---|
15 | ;
|
---|
16 | D PRNTPATS
|
---|
17 | I CRT,'QUIT D PAUSE
|
---|
18 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
19 | D ^%ZISC
|
---|
20 | K ^TMP($J)
|
---|
21 | Q
|
---|
22 | LINE(LINE) ;
|
---|
23 | ;Description: prints a line. First prints header if at end of page.
|
---|
24 | ;
|
---|
25 | I CRT,($Y>(IOSL-4)) D
|
---|
26 | .D PAUSE
|
---|
27 | .Q:QUIT
|
---|
28 | .W @IOF
|
---|
29 | .D HEADER
|
---|
30 | .W LINE
|
---|
31 | ;
|
---|
32 | E I ('CRT),($Y>(IOSL-2)) D
|
---|
33 | .W @IOF
|
---|
34 | .D HEADER
|
---|
35 | .W LINE
|
---|
36 | ;
|
---|
37 | E W !,LINE
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | GETPAT ;
|
---|
41 | ;Description: Gets patients to include in the report
|
---|
42 | ;for that reason
|
---|
43 | ;
|
---|
44 | N DFN,STATUS,I,DGENRIEN,DGENR,EFFDATE
|
---|
45 | S STATUS=""
|
---|
46 | F S STATUS=$O(^DPT("AENRC",STATUS)) Q:STATUS="" D
|
---|
47 | .S DFN=0
|
---|
48 | .F S DFN=$O(^DPT("AENRC",STATUS,DFN)) Q:'DFN D
|
---|
49 | ..S DGENRIEN=$$FINDCUR^DGENA(DFN)
|
---|
50 | ..Q:'$$GET^DGENA(DGENRIEN,.DGENR)
|
---|
51 | ..I $$CATEGORY^DGENA4(DFN)="P" D
|
---|
52 | ...;
|
---|
53 | ...N PREFAC,DGPFH,DGINST
|
---|
54 | ...S PREFAC=$$PREF^DGENPTA(DFN)
|
---|
55 | ...I PREFAC S DGPFH("PREFAC")=PREFAC,DGPFH("EFFDATE")=""
|
---|
56 | ...I PREFAC,'$$GETINST^DGENU($G(DGPFH("PREFAC")),.DGINST) S PREFAC=""
|
---|
57 | ...I (DGENINST("ALL")!$D(DGENINST(+PREFAC))),(DGENR("APP")>(DGENBEG-1)),(DGENR("APP")<(DGENEND+1)) D
|
---|
58 | ....S ^TMP($J,$$LJ($G(DGINST("STANUM")),10)_$$LJ($G(DGINST("NAME")),45),DGENR("STATUS"),DGENR("APP"),DGENRIEN)=$G(DGPFH("EFFDATE"))
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | HEADER ;
|
---|
62 | ;Description: Prints the report header.
|
---|
63 | ;
|
---|
64 | N LINE
|
---|
65 | W !,"Pending Applications For Enrollment - Enrollment Category is ""In Process"""
|
---|
66 | W !,"Date Range: "_$$FMTE^XLFDT(DGENBEG)_" to "_$$FMTE^XLFDT(DGENEND)
|
---|
67 | W ?50," Run Date: "_$$FMTE^XLFDT(DT)
|
---|
68 | W !
|
---|
69 | W !,"AppDt",?17,"Name",?64,"PatientID",?81,"DOB"
|
---|
70 | S $P(LINE,"-",132)="-"
|
---|
71 | W !,LINE
|
---|
72 | Q
|
---|
73 | ;
|
---|
74 | PAUSE ;
|
---|
75 | ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
|
---|
76 | ;
|
---|
77 | N DIR,X,Y
|
---|
78 | F Q:$Y>(IOSL-3) W !
|
---|
79 | S DIR(0)="E" D ^DIR
|
---|
80 | I ('(+Y))!$D(DIRUT) S QUIT=1
|
---|
81 | Q
|
---|
82 | ;
|
---|
83 | PRNTPATS ;
|
---|
84 | ;Description: Prints list of patients
|
---|
85 | ;
|
---|
86 | N PREFAC,APP,DGENRIEN,DGENR,DGPAT,LINE,STATUS
|
---|
87 | S PREFAC=""
|
---|
88 | F S PREFAC=$O(^TMP($J,PREFAC)) Q:PREFAC="" D Q:QUIT
|
---|
89 | .D LINE(" ") Q:QUIT
|
---|
90 | .D LINE("PREFERRED FACILITY: "_$S('(+PREFAC):"none",1:PREFAC)_" "_$G(^TMP($J,PREFAC))) Q:QUIT
|
---|
91 | .S STATUS=""
|
---|
92 | .F S STATUS=$O(^TMP($J,PREFAC,STATUS)) Q:STATUS="" D
|
---|
93 | ..D LINE(" ") Q:QUIT
|
---|
94 | ..D LINE(" ENROLLMENT STATUS: "_$$STATUS(STATUS)) Q:QUIT
|
---|
95 | ..S APP=""
|
---|
96 | ..F S APP=$O(^TMP($J,PREFAC,STATUS,APP)) Q:'APP D Q:QUIT
|
---|
97 | ...S DGENRIEN=0
|
---|
98 | ...F S DGENRIEN=$O(^TMP($J,PREFAC,STATUS,APP,DGENRIEN)) Q:'DGENRIEN D Q:QUIT
|
---|
99 | ....Q:'$$GET^DGENA(DGENRIEN,.DGENR)
|
---|
100 | ....Q:'$$GET^DGENPTA(DGENR("DFN"),.DGPAT)
|
---|
101 | ....S LINE=$$LJ($$DATE(APP),12)_" "_$$LJ(DGPAT("NAME"),45)_" "
|
---|
102 | ....S LINE=LINE_$$LJ(DGPAT("PID"),15)_" "_$$LJ($$DATE(DGPAT("DOB")),12)
|
---|
103 | ....D LINE(LINE)
|
---|
104 | Q
|
---|
105 | ;
|
---|
106 | STATUS(STATUS) ;
|
---|
107 | ;Description: Returns status name.
|
---|
108 | ;
|
---|
109 | Q $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
|
---|
110 | ;
|
---|
111 | DATE(DATE) ;
|
---|
112 | Q $$FMTE^XLFDT(DATE,"1")
|
---|
113 | ;
|
---|
114 | LJ(STRING,LENGTH) ;
|
---|
115 | Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)
|
---|