| 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
|
|---|
