Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW62.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW62.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW62.m
r613 r623 1 SCRPW62 ;BP-CIOFO/KEITH - SC veterans awaiting appointments ; 23 August 2002@20:23 ; Compiled August 20, 2007 14:21:08 2 ;;5.3;Scheduling;**267,269,358,491**;AUG 13, 1993;Build 53 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." 12 RPT 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 24 FMT 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 ; 40 QUE ;Queue output 41 ;W !!,"This report requires ",$S(SDELIM:"greater than ",1:""),"132 columns for output!" 42 W !!,"This report requires the following steps to be converted to 'EXCEL':" 43 W !,"1 - Copy it into WORD and replace '!^p' with null" 44 W !,"2 - Save this file as *.txt format" 45 W !,"3 - Open this file in 'EXCEL' with the All Files(*.*) type of file, listing it with one delimiter: '^'." 46 F SDX="SDELIM","SDRPT","SDSCVT","SDATES","SDDIV","SDDIV(","SDFMT" S ZTSAVE(SDX)="" 47 W ! D EN^XUTMDEVQ("START^SCRPW62","SC Veterans Awaiting Appointments",.ZTSAVE) D DISP0^SCRPW23 48 Q 49 ; 50 ENT ;Date entered parameters 51 S SDATES=1 Q 52 ; 53 ;Following logic suppressed by request 54 D SUBT^SCRPW50("**** Report Time Frame ****") 55 S DIR(0)="S^1:THE PAST YEAR;2:THE PAST TWO YEARS;3:THE PAST 3 YEARS" 56 S DIR("A")="Include SC veterans entered during" 57 S DIR("?")="Specify the time frame in which these patients were entered in VistA." 58 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q 59 S SDATES=Y 60 Q 61 ; 62 APPT ;Appointment delay parameters 63 I '$$DIVA^SCRPW17(.SDDIV) S SDOUT=1 Q 64 S SDATES=30 Q 65 ; 66 ;Following logic suppressed by request 67 D SUBT^SCRPW50("**** Report Time Frame ****") 68 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'" 69 S DIR("A")="Include SC veterans with future appointments greater than" 70 S DIR("?")="Specify the difference between 'desired date' and the appointement date." 71 W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q 72 S SDATES=Y 73 Q 74 ; 75 START ;Gather report data 76 N SDSTOP,SDOUT,SDSTOP,SDPAGE,SDLINE,SDPNOW,SDT,SDX 77 I '$D(ZTQUEUED),$E(IOST)="C" D WAIT^DICD 78 K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDPAGE=1,SDLINE="" 79 S $P(SDLINE,"-",(IOM+1))="" 80 S SDPNOW=$$FMTE^XLFDT($E($$NOW^XLFDT(),1,12)) 81 S SDX=$S(SDSCVT=1:"SC 50-100% ",SDSCVT=2:"SC < 50% ",1:"") 82 S SDT(1)="<*> SC VETERANS AWAITING APPOINTMENTS <*>" 83 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'") 84 D @(SDRPT_"^SCRPW63") W !! 85 D EXIT 86 Q 87 ; 88 SCEL(SDE,SDSCVT) ;Gather SC eligibility codes 89 ;Input: SDE=array to return list of codes in the format SDE(n) where 90 ; 'n' is the ifn in file #8 (pass by reference) 91 ; SDSCVT=type of SC vets to include 92 N SDE81,SDX,SDI,SDII 93 S SDI=0 F S SDI=$O(^DIC(8.1,SDI)) Q:'SDI D 94 .S SDX=$G(^DIC(8.1,SDI,0)) 95 .Q:$P(SDX,U,5)'="Y" S SDX=$P(SDX,U,4) 96 .I SDSCVT=1,SDX'=1 Q ;50-100% SC only 97 .I SDSCVT=2,SDX'=3 Q ;0-50% SC only 98 .I SDSCVT=3,(SDX'=1&(SDX'=3)) Q ;SC only 99 .S SDII=0 F S SDII=$O(^DIC(8,"D",SDI,SDII)) Q:'SDII D 100 ..S SDE(SDII)=SDX 101 ..Q 102 .Q 103 Q 104 ; 105 EXIT K ZTQUEUED,ZTSTOP,SDATES,SDDIV,SDFMT,SDRPT,SDELIM 106 D END^SCRPW50 Q 107 ; 108 HDR ;Print report header 109 N X 110 I SDELIM D HDRD Q 111 I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT 112 D STOP^SCRPW63 Q:SDOUT 113 W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) 114 W:$X $$XY^SCRPW50("",0,0) W SDLINE 115 S X=0 F S X=$O(SDT(X)) Q:'X W !?(IOM-$L(SDT(X))\2),SDT(X) 116 W !,SDLINE,!,"Date printed: ",SDPNOW,?((IOM-6)-$L(SDPAGE)),"Page: " 117 W SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q 118 ; 119 HDRD ;Header for delimited report 120 Q:SDPAGE>1 121 W !,SDLINE S X=0 F S X=$O(SDT(X)) Q:'X W !,SDT(X) 122 W !,"Date printed: ",SDPNOW,!,SDLINE 123 N ARR S ARR(1)="NAME^SSN^PRIM. ELIG.^DATE ENTERED^STREET ADDRESS^CITY^STATE^ZIP^PHONE NUMBER" 124 S:SDRPT="A" ARR(1)=ARR(1)_"^APPOINTMENT DATE^CLINIC^CREDIT PAIR^DIVISION^DATE APPT. ENTERED^DESIRED DATE^DIFFERENCE (DESIRED DATE - APPT. DATE)^DIFFERENCE (DATE APPT. ENTERED - DESIRED DATE)" 125 D DELIM(.ARR) 126 S SDPAGE=SDPAGE+1 Q 127 Q 128 ;W !,"NAME^SSN^PRIM. ELIG.^DATE ENTERED^STREET ADDRESS^CITY^STATE^ZIP^PHONE NUMBER" 129 ;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)" 130 ;S SDPAGE=SDPAGE+1 Q 131 DELIM(ARR) ;enter delimiter in the end of wrapped line 132 ;ARR - array of lines 133 N DELIM,II,LN,LL,JJ 134 S DELIM="!" 135 F II=1:1 S LN=$G(ARR(II)),LL=$L(LN) Q:'LL S LN=$P(LN," ")_DELIM_$P(LN," ",2,$L(LN," ")) F JJ=1:79:LL W !,$E(LN,JJ,JJ+78) W:JJ+79<LL DELIM I JJ+79=LL W $E(LN,LL) Q 1 SCRPW62 ;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." 12 RPT 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 24 FMT 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 ; 40 QUE ;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 ; 46 ENT ;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 ; 58 APPT ;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 ; 71 START ;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 ; 84 SCEL(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 ; 101 EXIT K ZTQUEUED,ZTSTOP,SDATES,SDDIV,SDFMT,SDRPT,SDELIM 102 D END^SCRPW50 Q 103 ; 104 HDR ;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 ; 115 HDRD ;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 TracChangeset
for help on using the changeset viewer.
