source: FOIAVistA/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACCSSTD.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1QACCSSTD ;WCIOFO/ERC - Routine for CSS totals ;8/16/97
2 ;;2.0;Patient Representative;**3,5,7,9,12**;07/25/1995
3DATE ; Establish date range
4 K QACDVTOT
5 N QACCSS,QACDC,QACDFLG,QACISS,QACNODIV,QACSFLG,QACSRV,QACSV,QACYES
6 S QACRTN="QACCSSTD"
7 S QACDESC="Customer Service Standards Totals"
8 S (QACSUM,QACYES)=0
9 S DIR(0)="SOA^D:Detailed;S:Summary"
10 S DIR("A")="Select report format: "
11 S DIR("A",1)="Report Format (D)etailed or (S)ummary:"
12 S DIR("?")="Select ""D"" for detailed or ""S"" for summary."
13 D ^DIR Q:$D(DIRUT)
14 K DIR
15 I Y="S" S QACSUM=1
16 D DATDIV^QACUTL0 Q:$G(QAQPOP)=1
17 I $G(QACDV)=0!($G(QACDV)']"") S QACNODIV=1
18 I $G(QACSUM)=1 G TASK
19 S DIR(0)="YOA"
20 S DIR("A")="Do you want to print this report for just one Discipline? "
21 S DIR("B")="No"
22 S DIR("?")="Enter 'YES' if you prefer to print this report for one specific Discipline."
23 D ^DIR Q:$D(DIRUT) I Y=1 D DISC
24 I QACYES=0 D
25 . S DIR("A")="Do you want to print this report for just one Service/Discipline? "
26 . S DIR("B")="No"
27 . S DIR("?")="Enter 'Yes' if you prefer to print this report for one Service/Discipline."
28 . D ^DIR Q:$D(DIRUT)
29 . I Y=1 D SERV
30 Q:$D(DIRUT)
31TASK ;
32 K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS G:POP EXIT
33 I $D(IO("Q")) D G EXIT
34 . S (ZTSAVE("QACD0"),ZTSAVE("QAISS"),ZTSAVE("QACISSC"))=""
35 . S ZTSAVE("QACSTD")=""
36 . S (ZTSAVE("QACSFLG"),ZTSAVE("QACDFLG"))=""
37 . S (ZTSAVE("QACDIS"),ZTSAVE("QACSVD"))=""
38 . S ZTDESC=QACDESC
39 . S ZTSAVE("QACCSS")=""
40 . S ZTSAVE("QACRTN")=""
41 . S ZTSAVE("QACSTD")=""
42 . S ZTSAVE("QAQRANG")=""
43 . S ZTSAVE("QACSUM")=""
44 . S ZTSAVE("QACEE")=""
45 . S ZTRTN="TSK^QACCSSTD"
46 . D TASK^QACUTL0
47 . Q
48TSK ; Get data for totaling
49 U IO
50INIT ; set up counters for each CSS, discipline and for the total count
51 D SETUP^QACEMPE
52 ;set up local array for CSS in external format
53 S QACAA=0
54 F S QACAA=$O(^QA(745.6,QACAA)) Q:QACAA'>0 D
55 . S QACSTD(QACAA)=$P(^QA(745.6,QACAA,0),U,2)
56 S QACROU="SET^QACCSSTD"
57 ;loop through "D" cross-reference (date)
58 D LOOP1^QACSPRD(QACROU,QAQNBEG,QAQNEND,.QACD0)
59 I $G(QACSUM)=1 D PRINTSUM D EXIT Q
60 D PRINT
61 D EXIT
62 Q
63SET ;
64 S QACDDV=$P(^QA(745.1,QACD0,0),U,16)
65 D INST^QACUTL0(QACDDV,.QACDDD)
66 I $G(QAC1DIV)]"" I $G(QAC1DIV)'=$G(QACDDV) Q
67 S QACDDV=QACDDD
68 ;if not integrated division set to 0 for sorting purposes in ^TMP
69 S QACDDV=$S($G(QACNODIV)'=1:$G(QACDDV,"Unknown"),1:0)
70 ;loops through the issue code multiple
71 K QACIC
72 D ISSLOOP^QACBYLOC
73 I '$D(QACIC) Q
74 S QACAA=0
75 F S QACAA=$O(QACIC(QACAA)) Q:QACAA'>0 D
76 . Q:'$D(^QA(745.2,QACIC(QACAA),0))
77 . S QACCSS=$P(^QA(745.2,QACIC(QACAA),0),U,7) Q:QACCSS']""
78 . S QACCSS=$P(^QA(745.6,QACCSS,0),U,2)
79 . I $G(QACSUM)=1 D COUNTSUM Q
80 . S QACBB=0,QACQUT=""
81 . F S QACBB=$O(^QA(745.1,QACD0,3,QACAA,3,QACBB)) Q:(QACBB'>0)&(QACBB]"") Q:$G(QACQUT) D
82 . . I $G(QACBB)'>0 I ($G(QACDFLG)=1!$G(QACSFLG)=1) S QACQUT=1 Q
83 . . I $G(QACBB)'>0 S (QACSVD,QACDIS)="Unknown",QACQUT=1 G COUNT
84 . . S QACNODE=^QA(745.1,QACD0,3,QACAA,3,QACBB,0)
85 . . S QACSVD=$P(^QA(745.55,$P(QACNODE,U),0),U) Q:$G(QACSVD)']""
86 . . I $G(QACSFLG)=1 I $G(QACSRV)'=$P(QACNODE,U) Q
87 . . I $P(QACNODE,U,2)]"" S QACDIS=$P(^QA(745.5,$P(QACNODE,U,2),0),U,2) Q:$G(QACDIS)']""
88 . . I $P(QACNODE,U,2)']"" S QACDIS="Unknown"
89 . . I $P(QACNODE,U,2)']"",($G(QACDISC)]"") Q ;if discipline
90 . . ;is unknown, there will be no match with the one discipline
91 . . ;in variable QACDISC
92 . . I $G(QACDFLG)=1 I $G(QACDISC)'=$P(^QA(745.5,$P(QACNODE,U,2),0),U) Q
93COUNT . . ;counts for detailed report
94 . . S QACTOT=$G(QACTOT)+1
95 . . I $G(QACDDV)]"" S QACDVTOT(QACDDV)=$G(QACDVTOT(QACDDV))+1
96 . . S ^TMP(QACRTN,$J,QACDDV,QACSVD,QACDIS,QACCSS)=$G(^TMP(QACRTN,$J,QACDDV,QACSVD,QACDIS,QACCSS))+1
97 . . S ^TMP(QACRTN,$J,"COUNT",QACDDV,QACSVD)=$G(^TMP(QACRTN,$J,"COUNT",QACDDV,QACSVD))+1
98 . .S ^TMP(QACRTN,$J,"COUNT",QACDDV,QACSVD,QACDIS)=$G(^TMP(QACRTN,$J,"COUNT",QACDDV,QACSVD,QACDIS))+1
99 Q
100PRINT ;print routine for detailed report
101 U IO
102 S QACEE=""
103 F S QACEE=$O(^TMP(QACRTN,$J,QACEE)) Q:QACEE']"" D Q:QACQUIT
104 . I QACEE="COUNT" Q
105 . S QACFF=""
106 . F S QACFF=$O(^TMP(QACRTN,$J,QACEE,QACFF)) Q:QACFF']"" D Q:QACQUIT
107 . . D HEAD
108 . . I $G(QACEE)'=0 W !?5,"Total for Division: "_QACEE_" "_QACDVTOT(QACEE)
109 . . I $G(QACFF)'=0 W !?5,"Total for Service/Discipline: "_QACFF_" "_^TMP(QACRTN,$J,"COUNT",QACEE,QACFF)
110 . . S QACGG=""
111 . . F S QACGG=$O(^TMP(QACRTN,$J,QACEE,QACFF,QACGG)) Q:QACGG']"" D Q:QACQUIT
112 . . . I $G(QACGG)'=0 W !?5,"Total for Discipline: "_QACGG_" "_^TMP(QACRTN,$J,"COUNT",QACEE,QACFF,QACGG),!
113 . . . S QACHH=""
114 . . . F S QACHH=$O(QACSTD(QACHH)) Q:QACHH']"" D Q:QACQUIT
115 . . . . I $Y>(IOSL-6) D HEAD Q:QACQUIT I $G(QACEE)'=0 W !?5,"Division: ",QACEE
116 . . . . W !?10,QACSTD(QACHH),?50,$G(^TMP(QACRTN,$J,QACEE,QACFF,QACGG,QACSTD(QACHH)),0)
117 W:$G(QACTOT)>0 !!?20,"Grand Total: "_QACTOT
118 I '$D(^TMP(QACRTN,$J)) D
119 . D HEAD
120 . W !!!?25,"No data to report."
121 Q
122HEAD ;
123 S QACPAGE=$G(QACPAGE)+1
124 I QACPAGE>1 D Q:QACQUIT
125 . W $C(7)
126 . I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QACQUIT=$S(Y'>0:1,1:0)
127 W:$E(IOST)="C"!(QACPAGE>1) @IOF
128 W !,QACDESC,?48,QACTODAY,?70,"PAGE ",QACPAGE
129 W !,"Date "_QAQRANG
130 W !,$S($G(QACSUM)=1:"SUMMARY",1:"DETAILED")," Report"
131 W !?51,"NUMBER OF"
132 W !?10,"CUSTOMER SERVICE STANDARD",?50,"OCCURRENCES"
133 W !,QACUNDL,!
134 Q
135EXIT ;
136 W ! D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
137 K ^TMP(QACRTN,$J)
138 K QAC1DIV,QACCSS,QACD0,QACDCNT,QACDESC,QACDDD,QACDDV,QACDFLG,QACDV
139 K QACDVTOT,QACDIS,QACDISC,QACIC,QACNODE,QACPAGE,QACQUIT,QACQUT
140 K QACROU,QACRTN,QACSFLG,QACSTD,QACSUM,QACSVD,QACTODAY,QACTOT,QACUNDL
141 K QACAA,QACBB,QACDD,QACEE,QACFF,QACGG,QACHH
142 K QAQNBEG,QAQNEND,QAQPOP,QAQRANG
143 K DIR,DIRUT,POP,ZTSAVE,ZTDESC,ZTRTN
144 D K^QAQDATE
145 Q
146DISC ; Select one discipline for this report
147 K DIR
148 S DIR(0)="FAO^^K:X'?2U X"
149 S DIR("A")="Enter the Discipline as a two letter abbreviation: "
150 D ^DIR K DIR Q:$D(DIRUT)!($D(DIROUT))
151 I $O(^QA(745.5,"B",Y,0)) S QACDISC=Y,QACDFLG=1,QACYES=1
152 E D G DISC
153 . W !!,"Not a valid Discipline, choose from:"
154 . S QACEE=0
155 . F S QACEE=$O(^QA(745.5,QACEE)) Q:QACEE'>0 D
156 . . W !?5,$P(^QA(745.5,QACEE,0),U)," (",$P(^QA(745.5,QACEE,0),U,2),")"
157 Q
158SERV ; Select one Service/Discipline for this report
159 K DIR
160 S DIR(0)="POA^745.55:EMZ"
161 S DIR("A")="Enter the Service/Discipline: "
162 D ^DIR K DIR Q:$D(DIRUT)!($D(DIROUT))
163 I $G(^QA(745.55,+Y,0))]"" S QACSRV=+Y,QACSFLG=1
164 E D G SERV
165 . W !!,"Not a valid service/discipline. Try again."
166 Q
167COUNTSUM ;counts for summary report
168 S QACBB=0
169 F S QACBB=$O(^QA(745.1,QACD0,3,QACAA,3,QACBB)) Q:QACBB'>0 D
170 . S ^TMP(QACRTN,$J,"TOT")=$G(^TMP(QACRTN,$J,"TOT"))+1
171 . S ^TMP(QACRTN,$J,"TOT",QACDDV)=$G(^TMP(QACRTN,$J,"TOT",QACDDV))+1
172 . S ^TMP(QACRTN,$J,"SUM",QACDDV,QACCSS)=$G(^TMP(QACRTN,$J,"SUM",QACDDV,QACCSS))+1
173 . S ^TMP(QACRTN,$J,"SUMCSS",QACCSS)=$G(^TMP(QACRTN,$J,"SUMCSS",QACCSS))+1
174 Q
175PRINTSUM ;print routine for summary report
176 U IO
177 D HEAD
178 I '$D(^TMP(QACRTN,$J)) D Q
179 . W !!!?25,"No data to report."
180 S QACDCN=0,QACEE=""
181 F S QACEE=$O(^TMP(QACRTN,$J,"SUM",QACEE)) Q:QACEE']"" D Q:QACQUIT
182 . S QACDCNT=$G(QACDCNT)+1
183 . I $G(QACEE)=0,($D(QAC1DIV)) W !?5,"For all Divisions"
184 . I $G(QACEE)'=0 W !?5,"Division: ",QACEE
185 . S QACGG=""
186 . F S QACGG=$O(QACSTD(QACGG)) Q:QACGG']"" D
187 . . I $Y>(IOSL-6) D HEAD Q:QACQUIT I $G(QACEE)'=0 W !?5,"Division: ",QACEE
188 . . W !?10,QACSTD(QACGG),?55,$G(^TMP(QACRTN,$J,"SUM",QACEE,QACSTD(QACGG)),0)
189 . W !?53,"-----"
190 . W !?45,"TOTAL:",?55,^TMP(QACRTN,$J,"TOT",QACEE)
191 I $G(QACDCNT)>1 D
192 . I $Y>(IOSL-6) D HEAD Q:QACQUIT I $G(QACEE)'=0 W !?5,"Division: ",QACEE
193 . W !!!?5,"Totals for all Divisions:"
194 . S QACFF=""
195 . F S QACFF=$O(QACSTD(QACFF)) Q:QACFF']"" D
196 . . I $Y>(IOSL-6) D HEAD Q:QACQUIT
197 . . W !?10,QACSTD(QACFF),?55,$G(^TMP(QACRTN,$J,"SUMCSS",QACSTD(QACFF)),0)
198 . W !?53,"-----"
199 . W !?38,"GRAND TOTAL:",?55,^TMP(QACRTN,$J,"TOT")
200 Q
Note: See TracBrowser for help on using the repository browser.