source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW62.m@ 1150

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

revised back to 6/30/08 version
File size: 5.2 KB
Line 
1SCRPW62 ;BP-CIOFO/KEITH - SC veterans awaiting appointments ; 23 August 2002@20:23
2 ;;5.3;Scheduling;**267,269,358**;AUG 13, 1993
3 ;
4 ;Prompt for report parameters
5 ;
6 N SDOUT,DIR,DTOUT,DUOUT,SDFMT,SDATES,SDDIV,SDRPT,SDSCVT
7 N SDELIM,SDX,ZTSAVE,X,Y
8 S SDOUT=0
9 D TITL^SCRPW50("SC Veterans Awaiting Appointments")
10 W !,"Note: Once the scheduling replacement application has been implemented at your"
11 W !,"site, this report will no longer be accurate."
12RPT D SUBT^SCRPW50("**** Report Type Selection ****")
13 S DIR(0)="S^E:ENTERED WITH NO APPOINTMENT PROVIDED;A:APPOINTMENTS BEYOND DATE DESIRED",DIR("A")="Select report type"
14 S DIR("?",1)="Specify 'E' to return SC veterans entered but not yet provided an appointment,"
15 S DIR("?")="'A' to return SC veterans with appointments beyond the date desired."
16 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT
17 K DIR S SDRPT=Y D ENT:SDRPT="E",APPT:SDRPT="A" G:SDOUT EXIT
18 D SUBT^SCRPW50("**** Patient Eligibility Selection ****")
19 S DIR(0)="S^1:50-100% SC Veterans;2:0-50% SC Veterans;3:All SC Veterans"
20 S DIR("A")="Select eligibility type"
21 S DIR("?")="Specify the eligibility of the patients you wish to include."
22 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT
23 K DIR S SDSCVT=Y
24FMT D SUBT^SCRPW50("**** Report Format Selection ****")
25 S DIR(0)="S^D:DETAILED REPORT;S:STATISTICS ONLY"
26 S DIR("A")="Select report format"
27 S DIR("?")="Specify the report format desired."
28 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT
29 K DIR S SDFMT=Y
30 I SDFMT="S" S SDELIM=0 G QUE
31 D SUBT^SCRPW50("**** Output Format Selection ****")
32 S DIR(0)="Y",DIR("A")="Return report output in delimited format"
33 S DIR("B")="NO"
34 S DIR("?",1)="Specify if you would like the report output to be in delimited format for"
35 S DIR("?",2)="transfer to a spreadsheet. The delimited output will not include rated SC"
36 S DIR("?")="disabilities for 0-50% SC veterans (as included in the text formatted report)."
37 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT
38 S SDELIM=Y
39 ;
40QUE ;Queue output
41 W !!,"This report requires ",$S(SDELIM:"greater than ",1:""),"132 columns for output!"
42 F SDX="SDELIM","SDRPT","SDSCVT","SDATES","SDDIV","SDDIV(","SDFMT" S ZTSAVE(SDX)=""
43 W ! D EN^XUTMDEVQ("START^SCRPW62","SC Veterans Awaiting Appointments",.ZTSAVE) D DISP0^SCRPW23
44 Q
45 ;
46ENT ;Date entered parameters
47 S SDATES=1 Q
48 ;
49 ;Following logic suppressed by request
50 D SUBT^SCRPW50("**** Report Time Frame ****")
51 S DIR(0)="S^1:THE PAST YEAR;2:THE PAST TWO YEARS;3:THE PAST 3 YEARS"
52 S DIR("A")="Include SC veterans entered during"
53 S DIR("?")="Specify the time frame in which these patients were entered in VistA."
54 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
55 S SDATES=Y
56 Q
57 ;
58APPT ;Appointment delay parameters
59 I '$$DIVA^SCRPW17(.SDDIV) S SDOUT=1 Q
60 S SDATES=30 Q
61 ;
62 ;Following logic suppressed by request
63 D SUBT^SCRPW50("**** Report Time Frame ****")
64 S DIR(0)="S^30:>30 DAYS BEYOND 'DESIRED DATE';60:>60 DAYS BEYOND 'DESIRED DATE;90:>90 DAYS BEYOND 'DESIRED DATE';180:>180 DAYS BEYOND 'DESIRED DATE'"
65 S DIR("A")="Include SC veterans with future appointments greater than"
66 S DIR("?")="Specify the difference between 'desired date' and the appointement date."
67 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
68 S SDATES=Y
69 Q
70 ;
71START ;Gather report data
72 N SDSTOP,SDOUT,SDSTOP,SDPAGE,SDLINE,SDPNOW,SDT,SDX
73 I '$D(ZTQUEUED),$E(IOST)="C" D WAIT^DICD
74 K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDPAGE=1,SDLINE=""
75 S $P(SDLINE,"-",(IOM+1))=""
76 S SDPNOW=$$FMTE^XLFDT($E($$NOW^XLFDT(),1,12))
77 S SDX=$S(SDSCVT=1:"SC 50-100% ",SDSCVT=2:"SC < 50% ",1:"")
78 S SDT(1)="<*> SC VETERANS AWAITING APPOINTMENTS <*>"
79 S SDT(2)=$S(SDRPT="E":SDX_"PATIENTS ENTERED IN THE PAST "_$S(SDATES=1:"YEAR",1:SDATES_" YEARS")_" WITHOUT AN APPOINTMENT",1:SDX_"PATIENTS WAITING > "_SDATES_" DAYS BEYOND APPOINTMENT 'DESIRED DATE'")
80 D @(SDRPT_"^SCRPW63") W !!
81 D EXIT
82 Q
83 ;
84SCEL(SDE,SDSCVT) ;Gather SC eligibility codes
85 ;Input: SDE=array to return list of codes in the format SDE(n) where
86 ; 'n' is the ifn in file #8 (pass by reference)
87 ; SDSCVT=type of SC vets to include
88 N SDE81,SDX,SDI,SDII
89 S SDI=0 F S SDI=$O(^DIC(8.1,SDI)) Q:'SDI D
90 .S SDX=$G(^DIC(8.1,SDI,0))
91 .Q:$P(SDX,U,5)'="Y" S SDX=$P(SDX,U,4)
92 .I SDSCVT=1,SDX'=1 Q ;50-100% SC only
93 .I SDSCVT=2,SDX'=3 Q ;0-50% SC only
94 .I SDSCVT=3,(SDX'=1&(SDX'=3)) Q ;SC only
95 .S SDII=0 F S SDII=$O(^DIC(8,"D",SDI,SDII)) Q:'SDII D
96 ..S SDE(SDII)=SDX
97 ..Q
98 .Q
99 Q
100 ;
101EXIT K ZTQUEUED,ZTSTOP,SDATES,SDDIV,SDFMT,SDRPT,SDELIM
102 D END^SCRPW50 Q
103 ;
104HDR ;Print report header
105 N X
106 I SDELIM D HDRD Q
107 I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
108 D STOP^SCRPW63 Q:SDOUT
109 W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0)
110 W:$X $$XY^SCRPW50("",0,0) W SDLINE
111 S X=0 F S X=$O(SDT(X)) Q:'X W !?(IOM-$L(SDT(X))\2),SDT(X)
112 W !,SDLINE,!,"Date printed: ",SDPNOW,?((IOM-6)-$L(SDPAGE)),"Page: "
113 W SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q
114 ;
115HDRD ;Header for delimited report
116 Q:SDPAGE>1
117 W !,SDLINE S X=0 F S X=$O(SDT(X)) Q:'X W !,SDT(X)
118 W !,"Date printed: ",SDPNOW,!,SDLINE
119 W !,"NAME^SSN^PRIM. ELIG.^DATE ENTERED INTO FILE^STREET ADDRESS^CITY^STATE^ZIP^PHONE NUMBER"
120 W:SDRPT="A" "^APPOINTMENT DATE^CLINIC^CREDIT PAIR^DIVISION^DATE APPT. ENTERED^DESIRED DATE^DIFFERENCE (DESIRED DATE - APPT. DATE)^DIFFERENCE (DATE APPT. ENTERED - DESIRED DATE)"
121 S SDPAGE=SDPAGE+1 Q
Note: See TracBrowser for help on using the repository browser.