source: FOIAVistA/trunk/r/CMOP-PSX/PSXRSTAT.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1PSXRSTAT ;BIR/HTW-Rx Workload Report ; 30 Oct 2000 5:08 PM
2 ;;2.0;CMOP;**31**;11 Apr 97
3 ; External reference to ^PSRX( supported by DBIA #1221
4 ; External reference to ^PS(52.5 supported by DBIA #1222
5 ; External reference to ^PS(59 supported by DBIA #1976
6 ;
7 D EXIT
8BEGDATE S DIR(0)="DO",DIR("A")="ENTER BEGINNING DATE " D ^DIR K DIR
9 G:$D(DIRUT)!(X']"") END
10 S PSXB=Y K Y,X
11 I PSXB>DT W !!,"Future dates are not allowed.",! G BEGDATE
12ENDDATE S Y=DT X ^DD("DD") S ZZTODAY=Y K Y
13 K X,Y
14 S DIR(0)="DO",DIR("A")="ENTER ENDING DATE ",DIR("B")=ZZTODAY
15 D ^DIR K DIR
16 G:$D(DIRUT) END
17 S PSXE=Y K Y
18 I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
19 K ZZTODAY
20 D SEL Q:'$D(DIVDA)
21DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
22 D ^%ZIS G:POP END S PSXLAP=ION
23 I IOST["C-" G START
24 I '$D(IO("Q")) G ST0
25 D ^%ZISC K J,C
26QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVDA(")="",ZTSAVE("DIVNM(")="",ZTIO=PSXLAP
27 S ZTRTN="START^PSXRSTAT"
28 S ZTDESC="CMOP Rx Workload Report"
29 D ^%ZTLOAD
30Q1 W:$D(ZTSK) !!,"Report Queued to Print!!"
31 K DIR,PSXB,PSXE,Y
32 Q
33ST0 U IO
34 ;Taskman entry point to start the CMOP Workload Report
35START S:$D(ZTQUEUED) ZTREQ="@"
36 S LINE="W ! F I=1:1:80 W ""="""
37 K TOTAL,TOTALT
38 S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:'DIVDA D Q:$G(PSXFLAG)=1
39 .S (PSXAD,PSXOT)=0,PSXE1=PSXE,PSXXE=PSXE,PSXXB=PSXB
40 .S PSXD=PSXB-.00001
41 .S LINE="W ! F I=1:1:80 W ""="""
42 .D DIVISION X LINE S DIV=DIVDA D DIVSUML
43 .D END
44 .S PSXE=PSXXE,PSXB=PSXXB K PSXXE,PSXXE
45 D GRNDTOT
46 D ^%ZISC
47 D END
48 Q
49DIVISION ;
50 D TITLE
51 F S PSXD=$O(^PSRX("AD",PSXD)) Q:(+PSXD'>0)!(+PSXD>PSXE1) D ONE I $G(PSXD1)'=PSXD D MAIN Q:$G(PSXFLAG)=1
52 D GTOTAL
53 Q
54END K PSXD,PSXE,PSXF,PSXAD,PSXOT,PSXR,PSXLINE,PSXE1,PSXD1
55 K DIR,X,Y,%,PSXUNREL,PSXB,POP,PSXLAP,PSXNOW,ZTDESC,ZTIO,ZTRTN,ZTSAVE
56 K PSXMW,PSXM,PSXW,A,B,C,D,E,PSXCR,PSXCU,PSXSUSDT,ZTSK,PSXMT,PSXWT
57 K DIRUT,DTOUT,DUOUT,PSXFLAG,ZDATE,ZZTOT,DIROUT,ZFILL,PSXSTAT
58 Q
59ONE F PSXR=0:0 S PSXR=$O(^PSRX("AD",PSXD,PSXR)) Q:'PSXR D TWO Q:$G(PSXFLAG)=1
60 Q
61TWO S PSXF="" F S PSXF=$O(^PSRX("AD",PSXD,PSXR,PSXF)) Q:($G(PSXF)']"") D COUNT K PSX,PSXREL,PSXMW Q:$G(PSXFLAG)=1
62 Q
63COUNT ;
64 I PSXF=0 S DIV=$P(^PSRX(PSXR,2),U,9) Q:DIV'=DIVDA
65 I PSXF>0 S DIV=$P(^PSRX(PSXR,1,PSXF,0),U,9) Q:DIV'=DIVDA
66 S PSXRNM=$P(^PSRX(PSXR,0),U,1)
67 I PSXF=0 Q:'$D(^PSRX(PSXR,0)) D
68 .S PSXMW=$P($G(^PSRX(PSXR,0)),"^",11)
69 .I $G(PSXMW)="M" S PSXMT=$G(PSXMT)+1 Q
70 .I $G(PSXMW)="W" S PSXWT=$G(PSXWT)+1
71 .I PSXRNM'=+PSXRNM S PSXWRN=$G(PSXWRN)+1
72 I PSXF>0 Q:'$D(^PSRX(PSXR,1,PSXF,0)) D
73 .S PSXMW=$P($G(^PSRX(PSXR,1,PSXF,0)),"^",2)
74 .I $G(PSXMW)="M" S PSXMT=$G(PSXMT)+1 Q
75 .I $G(PSXMW)="W" S PSXWT=$G(PSXWT)+1,PSXWRF=$G(PSXWRF)+1
76 I $G(PSXMW)="M" S TOTAL("MAIL")=$G(TOTAL("MAIL"))+1
77 I $G(PSXMW)="W" S TOTAL("WINDOW")=$G(TOTAL("WINDOW"))+1
78 S PSXAD=PSXAD+1
79 I $D(^PSRX(PSXR,4,0)) F PSX=0:0 S PSX=$O(^PSRX(PSXR,4,PSX)) Q:'PSX D
80 .S ZFILL=$P($G(^PSRX(PSXR,4,PSX,0)),"^",3)
81 .I $G(ZFILL)'=PSXF K ZFILL Q
82 .S PSXSTAT=$P($G(^PSRX(PSXR,4,PSX,0)),"^",4)
83 .S PSX(ZFILL)=PSXSTAT
84 I $G(PSX(PSXF))=1 S PSXCR=$G(PSXCR)+1,TOTAL("CMOP RELEASED")=$G(TOTAL("CMOP RELEASED"))+1 Q
85 I $G(PSX(PSXF))=0!($G(PSX(PSXF))=2) S PSXCU=$G(PSXCU)+1,TOTAL("CMOP UNRELEASED")=$G(TOTAL("CMOP UNRELEASED"))+1 Q
86 ;Check if in suspense...
87 I $D(^PS(52.5,"B",PSXR)) S PSXST=$O(^(PSXR,"")) I $D(^PS(52.5,PSXST,0)) D
88 .S PSXST1=$P($G(^PS(52.5,PSXST,0)),"^",7) Q:$G(PSXST1)']""
89 .S PSXSUSDT=$P(^PS(52.5,PSXST,0),"^",2)
90 .I PSXF=0 S PSXFDT=$P($G(^PSRX(PSXR,2)),"^",2)
91 .I PSXF>0 S PSXFDT=$P($G(^PSRX(PSXR,1,PSXF,0)),"^") Q:'$G(PSXFDT)
92 .I PSXSUSDT=PSXFDT,(PSXST1="L") S PSX(PSXF)=PSXST1,PSXCU=$G(PSXCU)+1,TOTAL("CMOP RELEASED")=$G(TOTAL("CMOP RELEASED"))+1
93 K PSXSTAT,ZFILL,PSXST,PSXST1,ZZ,PSXSUS,PSXFDT
94 I $G(PSX(PSXF))="L" Q
95OP I PSXF=0 S PSXREL=$P($G(^PSRX(PSXR,2)),"^",13)
96 I PSXF>0 S PSXREL=$P($G(^PSRX(PSXR,1,PSXF,0)),"^",18)
97 I $G(PSXREL),($G(PSXMW)="M") S PSXM=$G(PSXM)+1,TOTAL("OP MAIL")=$G(TOTAL("OP MAIL"))+1 Q
98 I $G(PSXREL),($G(PSXMW)="W") S PSXW=$G(PSXW)+1,TOTAL("OP WINDOW")=$G(TOTAL("OP WINDOW"))+1 D Q
99 .I PSXRNM'=+PSXRNM,PSXF=0 S PSXRRN=$G(PSXRRN)+1
100 .I PSXF>0 S PSXRRF=$G(PSXRRF)+1
101 S PSXUNREL=$G(PSXUNREL)+1,TOTAL("OTHER")=$G(TOTAL("OTHER"))+1
102 Q
103TITLE Q:$G(PSXFLAG)=1
104 I IOST["C-" W @IOF
105 S Y=PSXB X ^DD("DD") S PSXB=Y
106 S Y=PSXE X ^DD("DD") S PSXE=Y
107 D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
108 W !!!,?30,"Rx WORKLOAD BREAKDOWN"_$S($G(ZZTOT)=1:" SUMMARY",1:"")
109 W !,DIVDA(DIVDA)
110 W !,"FROM: ",PSXB," TO: ",$P(PSXE,"@")," PRINTED: ",PSXNOW
111 S PSXLINE=6
112 X LINE
113AHEAD W !,"DATE",?8,"TOTAL",?17,"ENTERED",?35,"OUTPATIENT",?47,"RELEASED",?65,"CMOP",?74,"OTHER"
114 W !,?8,"MAIL",?17,"WINDOW",?35,"MAIL",?47,"WINDOW",?65,"Released"
115 W !,?17,"Tot",?23,"Ref",?29,"Rn1",?47,"Tot",?53,"Ref",?59,"Rn1"
116 X LINE
117 Q
118MAIN I IOST["C-",($G(PSXLINE)>20) D Q:$G(PSXFLAG)=1
119 .S DIR(0)="E" D ^DIR K DIR I $G(Y)'=1 S PSXFLAG=1 K Y Q
120 .D TITLE
121 I IOST'["C-",($G(PSXLINE)>60) W @IOF D TITLE
122 S PSXUNREL=$G(PSXUNREL)+$G(PSXCU)
123 S ZDATE=$E(PSXD,4,5)_"/"_$E(PSXD,6,7)
124 S A=19-($L($G(PSXWT))\2),B=29-($L($G(PSXM))\2),C=40-($L($G(PSXW))\2),D=57-($L($G(PSXCR))\2),E=72-($L($G(PSXUNREL))\2)
125 ;W !,ZDATE,?10,$G(PSXMT),?A,$G(PSXWT),?B,$G(PSXM),?C,$G(PSXW),?D,$G(PSXCR),?E,$G(PSXUNREL)
126 W !,ZDATE,?8,+$G(PSXMT),?17,+$G(PSXWT),?23,+$G(PSXWRF),?29,+$G(PSXWRN),?35,+$G(PSXM),?47,+$G(PSXW),?53,+$G(PSXRRF),?59,+$G(PSXRRN),?65,+$G(PSXCR),?74,+$G(PSXUNREL)
127 S PSXD1=PSXD,PSXLINE=$G(PSXLINE)+1
128 S TOTALT(DIVDA,"WINDOW REFIL")=$G(TOTALT(DIVDA,"WINDOW REFIL"))+$G(PSXWRF)
129 S TOTALT(DIVDA,"WINDOW RENEW")=$G(TOTALT(DIVDA,"WINDOW RENEW"))+$G(PSXWRN)
130 S TOTALT(DIVDA,"RELEASE REFIL")=$G(TOTALT(DIVDA,"RELEASE REFIL"))+$G(PSXRRF)
131 S TOTALT(DIVDA,"RELEASE RENEW")=$G(TOTALT(DIVDA,"RELEASE RENEW"))+$G(PSXRRN)
132 K PSXMT,PSXWT,PSXCR,PSXCU,PSXM,PSXW,PSXCR,PSXUNREL,PSXWRF,PSXWRN,PSXRRF,PSXRRN
133 Q
134GTOTAL ;
135 Q:$G(PSXFLAG)=1
136 F X="MAIL","WINDOW","OP MAIL","OP WINDOW","CMOP RELEASED","CMOP UNRELEASED","OTHER" S TOTALT(DIVDA,X)=$G(TOTAL(X))
137 K TOTAL
138 I IOST["C-",($G(PSXLINE)<20) S DIR(0)="E" D ^DIR K DIR Q:(Y="")
139 Q
140GRNDTOT ;EP WRITE /LOOP DIVISIONAL TOTALS & WRITE GRAND TOTALS
141 Q:$G(PSXFLAG)=1
142 W @IOF
143 S DIVDA(0)=" Grand Total Summary",DIVDA=0
144 D TITLE
145 S LINE="W ! F I=1:1:80 W ""="""
146 S DIV=0 F S DIV=$O(DIVDA(DIV)) Q:'DIV D
147 .D DIVSUM
148 .F X="MAIL","WINDOW","OP MAIL","OP WINDOW","CMOP RELEASED","CMOP UNRELEASED","OTHER","WINDOW RENEW","WINDOW REFIL","RELEASE REFIL","RELEASE RENEW" S TOTALT(0,X)=$G(TOTALT(0,X))+$G(TOTALT(DIV,X))
149 X LINE
150 S DIV=0 D DIVSUML
151 Q
152DIVSUM ;EP DIVISIONAL SUMMARY
153 Q:$G(PSXFLAG)=1
154 W !,DIVDA(DIV)
155DIVSUML ;
156 Q:$G(PSXFLAG)=1
157 W !,?8,+$G(TOTALT(DIV,"MAIL"))
158 W ?17,+$G(TOTALT(DIV,"WINDOW"))
159 W ?23,+$G(TOTALT(DIV,"WINDOW REFIL"))
160 W ?29,+$G(TOTALT(DIV,"WINDOW RENEW"))
161 W ?35,+$G(TOTALT(DIV,"OP MAIL"))
162 W ?47,+$G(TOTALT(DIV,"OP WINDOW"))
163 W ?53,+$G(TOTALT(DIV,"RELEASE REFIL"))
164 W ?59,+$G(TOTALT(DIV,"RELEASE RENEW"))
165 W ?65,+$G(TOTALT(DIV,"CMOP RELEASED"))
166 W ?74,+($G(TOTALT(DIV,"CMOP UNRELEASED"))+$G(TOTALT(DIV,"OTHER")))
167 I IOST["C-" S DIR(0)="E" D ^DIR K DIR Q:(Y="")
168 Q
169SEL ;Select divisions
170 ; returns arrays
171 ; DIVNM("names of divisions")=selection number
172 ; DIVDA("iens of divisions")=name of division
173 ; for testing
174 W !!,"SELECTION OF DIVISION(S)",!
175 S DIV="" K DIVNM,DIVDA,DIVX
176 F I=1:1 S DIV=$O(^PS(59,"B",DIV)) Q:DIV="" S DIVNM(I)=DIV,DIVNM(DIV)=I,DIVDA=$O(^PS(59,"B",DIV,0)),DIVNM(I,"I")=DIVDA
177 S I=I-1
178 K DIR
179 S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
180 D ^DIR K DIR
181 G:Y="A" ALL
182 G:Y="S" SELECT
183 Q
184SELECT ;
185 F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
186 S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
187 D ^DIR
188 I '+Y K DIVNM Q
189 M DIVX=DIVNM K DIVNM
190 F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
191 K DIVX,DIR
192ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
193 S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
194 K DIR
195 I Y D Q
196 .K DIVDA
197 .S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
198 G SEL
199 ;
200TOTALT ;
201 S X="TOTALT" F S X=$Q(@X) Q:X="" W !,X,?30,@X
202 Q
203EXIT D END
204 K DIVDA,TOTAL,TOTALT,I,LINE,PSXRRF,PSXXB,PSXRNM,DIV
205 Q
Note: See TracBrowser for help on using the repository browser.