source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENRPD2.m@ 1766

Last change on this file since 1766 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1DGENRPD2 ;ALB/CJM/EG -Veteran with Future Appts and no Enrollment App Report - Continue 01/19/2005 ; 1/20/05 1:27pm
2 ;;5.3;Registration;**147,232,568,585,725,767**;Aug 13,1993;Build 2
3 ;
4PRINT ;
5 N CRT,QUIT,PAGE,SUBSCRPT
6 K ^TMP($J)
7 S QUIT=0
8 S PAGE=0
9 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
10 ;
11 D GETPAT
12 U IO
13 I CRT,PAGE=0 W @IOF
14 S PAGE=1
15 D HEADER
16 F SUBSCRPT="STEP2","NOENREC" D
17 .D PATIENTS(SUBSCRPT)
18 I CRT,'QUIT D PAUSE
19 I $D(ZTQUEUED) S ZTREQ="@"
20 D ^%ZISC
21 ;
22 K ^TMP($J)
23 Q
24LINE(LINE) ;
25 ;Description: prints a line. First prints header if at end of page.
26 ;
27 I CRT,($Y>(IOSL-4)) D
28 .D PAUSE
29 .Q:QUIT
30 .W @IOF
31 .D HEADER
32 .W LINE
33 ;
34 E I ('CRT),($Y>(IOSL-2)) D
35 .W @IOF
36 .D HEADER
37 .W LINE
38 ;
39 E W !,LINE
40 Q
41 ;
42GETPAT ;
43 ; Description: Gets patients to include in the report
44 N BEGIN,END,DGARRAY,SDCNT,CATEGORY,DIVISION,NAM
45 S BEGIN=DGENRP("BEGIN")_".0000",END=DGENRP("END")_".2359",DGARRAY(1)=BEGIN_";"_END
46 S DGARRAY("FLDS")="3;10",SDCNT=$$SDAPI^SDAMA301(.DGARRAY)
47 ;
48 ;there must be subscripts underneath the 101 level to be a
49 ;valid appointment, else it is an error eg 01/20/2005
50 ; Appointment Database is Unavailable
51 I SDCNT<0 N X S X=$$FAPCHK I X'="" S NAM=X G ERR
52 ;
53 ; Get All records for report
54 I DGENRP("ALL") D
55 .S CLINIC=0 F S CLINIC=$O(^TMP($J,"SDAMA301",CLINIC)) Q:'CLINIC D
56 ..Q:$P($G(^SC(CLINIC,0)),"^",3)'="C"
57 ..S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",CLINIC,DFN)) Q:'DFN D
58 ...S DIVISION=$P($G(^SC(CLINIC,0)),U,15)
59 ...S:'DIVISION DIVISION=$O(^DG(40.8,0))
60 ...D VALREC(CLINIC,DFN)
61 ;
62 ; Get records for specified Divisions only
63 I $O(DGENRP("DIVISION",0)) D
64 .S CLINIC=0 F S CLINIC=$O(^TMP($J,"SDAMA301",CLINIC)) Q:'CLINIC D
65 ..Q:$P($G(^SC(CLINIC,0)),"^",3)'="C"
66 ..S DIVISION=$P($G(^SC(CLINIC,0)),U,15)
67 ..S:'DIVISION DIVISION=$O(^DG(40.8,0))
68 ..Q:'DIVISION!('$D(DGENRP("DIVISION",DIVISION)))
69 ..S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",CLINIC,DFN)) Q:'DFN D VALREC(CLINIC,DFN)
70 ;
71 ; Get records for specified Clinics only
72 I $O(DGENRP("CLINIC",0)) D
73 .S CLINIC=0 F S CLINIC=$O(^TMP($J,"SDAMA301",CLINIC)) Q:'CLINIC D
74 ..Q:'CLINIC!('$D(DGENRP("CLINIC",CLINIC)))
75 ..Q:($P($G(^SC(CLINIC,0)),U,3)'="C")
76 ..S DIVISION=$P($G(^SC(CLINIC,0)),U,15)
77 ..S:'DIVISION DIVISION=$O(^DG(40.8,0))
78 ..S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",CLINIC,DFN)) Q:'DFN D VALREC(CLINIC,DFN)
79 ;
80 K DGARRAY,^TMP($J,"SDAMA301"),SDCNT
81 Q
82 ;
83ERR ;
84 ;^TMP($J,TYPE,DIVISION NAME,CLINIC NAME,CATEGORY,APPT DT/TM,DFN)
85 I NAM["Appointment Database is unavailable. Please try again later." S NAM="**Appointment Database is Unavailable**"
86 I NAM["Appointment request contains invalid values." S NAM="**Invalid appointment, call Help Desk**"
87 I NAM["An error has occurred. Check the RSA Error Log." S NAM="**Error, check RSA Error Log **"
88 S ^TMP($J,"NOENREC"," ",NAM," ",DT," ")=""
89 K DGARRAY,^TMP($J,"SDAMA301"),SDCNT,NAM
90 Q
91 ;
92VALREC(CLINIC,DFN) ;
93 ;
94 N APPT,STATUS,JUSTONCE S JUSTONCE=0
95 S APPT=0 F S APPT=$O(^TMP($J,"SDAMA301",CLINIC,DFN,APPT)) Q:'APPT!(JUSTONCE) D
96 .S JUSTONCE=+$G(DGENRP("JUSTONCE"))
97 .; Exclude certain appointment statuses
98 .S STATUS=$P($P(^TMP($J,"SDAMA301",CLINIC,DFN,APPT),U,3),";")
99 .Q:"^NS^NSR^CC^CCR^CP^CPR^"[(U_STATUS_U)
100 .;
101 .; Don't include enrolled veterans or ones that have pending apps
102 .S CATEGORY=$$CATEGORY^DGENA4(DFN)
103 .I (CATEGORY="E")!(CATEGORY="P") Q
104 .;
105 .; Exclude if not an eligible veteran (can not enroll)
106 .Q:'$$VET^DGENPTA(DFN)
107 .;
108 .D SETTMP(CLINIC,DFN,APPT)
109 Q
110 ;
111SETTMP(CLINIC,DFN,APPT) ;
112 ; NOENREC is for patients without enrollment records
113 ; SITE2 is for other excluded enrollment records
114 ;^TMP($J,TYPE,DIVISION NAME,CLINIC NAME,CATEGORY,APPT DT/TM,DFN)
115 ;
116 N DIVNAME,CLNAME
117 S DIVNAME=$S(DIVISION:$P($$SITE^VASITE(APPT\1,DIVISION),U,2),1:" ")
118 S CLNAME=$P($G(^SC(CLINIC,0)),"^")
119 S:CLNAME="" CLNAME=" "
120 ;
121 I $$FINDCUR^DGENA(DFN)="" S ^TMP($J,"NOENREC",DIVNAME,CLNAME,CATEGORY,APPT,DFN)="" Q
122 S ^TMP($J,"STEP2",DIVNAME,CLNAME,CATEGORY,APPT,DFN)=$$STATUS^DGENA(DFN)_U_$P($P(^TMP($J,"SDAMA301",CLINIC,DFN,APPT),U,10),";",2)
123 Q
124 ;
125HEADER ;
126 ;Description: Prints the report header.
127 ;
128 N LINE
129 I $Y>1 W @IOF
130 W !,"Appointments for Veterans with no Enrollment Application"
131 W:DGENRP("BEGIN") ?70,"Date Range: "_$$FMTE^XLFDT(DGENRP("BEGIN"))_" to "_$$FMTE^XLFDT($G(DGENRP("END")))
132 W ?120,"Page ",PAGE
133 S PAGE=PAGE+1
134 W !
135 W ?70," Run Date: "_$$FMTE^XLFDT(DT)
136 W !
137 ;
138 W !,"Name",?39,"PatientID",?57,"DOB",?70,"Appt Dt/Tm",?90,"EnrollStatus",?121,"Enroll Cat"
139 S $P(LINE,"-",132)="-"
140 W !,LINE,!
141 Q
142 ;
143PAUSE ;
144 ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
145 ;
146 N DIR,X,Y
147 F Q:$Y>(IOSL-3) W !
148 S DIR(0)="E"
149 D ^DIR
150 I ('(+Y))!$D(DIRUT) S QUIT=1
151 Q
152 ;
153PATIENTS(SUBSCRPT) ;
154 ;Description: Prints list of patients
155 ;
156 N NODE,DIVISION,CLINIC,TIME,PATIENT,DGPAT,APPTYPE,ENRSTAT,CATEGORY
157 ;
158 ;
159 S DIVISION=""
160 F S DIVISION=$O(^TMP($J,SUBSCRPT,DIVISION)) Q:DIVISION="" D Q:QUIT
161 .D LINE(" ") Q:QUIT
162 .D LINE($$LJ(" ",40)_"DIVISION: "_DIVISION) Q:QUIT
163 .D LINE(" ") Q:QUIT
164 .S CLINIC=""
165 .F S CLINIC=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC)) Q:CLINIC="" D Q:QUIT
166 ..D LINE(" ") Q:QUIT
167 ..D LINE("CLINIC: "_$$LJ(CLINIC,40)_$$LJ(" ",40)_"DIVISION: "_DIVISION)
168 ..Q:QUIT
169 ..S CATEGORY=""
170 ..F S CATEGORY=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY)) Q:CATEGORY="" D Q:QUIT
171 ...D LINE(" ") Q:QUIT
172 ...S TIME=0
173 ...F S TIME=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME)) Q:'TIME D Q:QUIT
174 ....S DFN=0
175 ....F S DFN=$O(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME,DFN)) Q:'DFN D Q:QUIT
176 .....S NODE=$G(^TMP($J,SUBSCRPT,DIVISION,CLINIC,CATEGORY,TIME,DFN))
177 .....S ENRSTAT=$P(NODE,"^")
178 .....S APPTYPE=$P(NODE,"^",2)
179 .....Q:'$$GET^DGENPTA(DFN,.DGPAT)
180 .....S LINE=$$LJ(DGPAT("NAME"),37)_" "_$$LJ(DGPAT("PID"),15)_" "
181 .....S LINE=LINE_$$LJ($$DATE(DGPAT("DOB")),12)_" "
182 .....S LINE=LINE_$$LJ($$DATE(TIME),20)
183 .....S LINE=LINE_" "_$$LJ($S(ENRSTAT="":"NO ENROLLMENT RECORD",1:$$EXT^DGENU("STATUS",ENRSTAT)),28)
184 .....S LINE=LINE_$$LJ(" ",2)_$$EXTCAT^DGENA4(CATEGORY)
185 .....D LINE(LINE)
186 .....Q:QUIT
187 Q
188 ;
189DATE(DATE) ;
190 Q $$FMTE^XLFDT(DATE,"1")
191 ;
192LJ(STRING,LENGTH) ;
193 Q $$LJ^XLFSTR($E(STRING,1,LENGTH),LENGTH)
194 ;
195FAPCHK() ;
196 N ERR
197 S ERR=$O(^TMP($J,"SDAMA301",""))
198 I $D(^TMP($J,"SDAMA301",ERR))=1 Q ^TMP($J,"SDAMA301",ERR)
199 Q ""
Note: See TracBrowser for help on using the repository browser.