source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RALWKL1.m@ 1046

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1RALWKL1 ;HISC/GJC-Workload Reports By Functional Area ;4/12/96 10:18
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3EN1 ; Entry point
4 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RATDY=Y,$P(RALN,"-",81)=""
5 S BEGDATE("X")=$$FMTE^XLFDT(BEGDATE,1)
6 S ENDDATE("X")=$$FMTE^XLFDT(ENDDATE,1),RAPG=0 W:$Y>0 @IOF
7 I RASUM D EN1^RALWKL4 Q ; Do summary report quit.
8 S RADIV=$O(^TMP($J,"RA","")),RAIMG=$O(^TMP($J,"RA",RADIV,""))
9 S RADIV="" F S RADIV=$O(^TMP($J,"RA",RADIV)) Q:RADIV']"" D Q:RAXIT
10 . S RAIMG="" F S RAIMG=$O(^TMP($J,"RA",RADIV,RAIMG)) Q:RAIMG']"" D Q:RAXIT
11 .. S RAFLD=""
12 .. F S RAFLD=$O(^TMP($J,"RA",RADIV,RAIMG,RAFLD)) Q:RAFLD']"" D Q:RAXIT
13 ... S RATTL0=$G(^TMP($J,"RA",RADIV,RAIMG,RAFLD)),RAWWU1=$P(RATTL0,"^",5)
14 ... S RATTL1=0 F I=1:1:4 S RATTL1=RATTL1+$P(RATTL0,"^",I)
15 ... S RAMIS=0
16 ... F S RAMIS=$O(^TMP($J,"RA",RADIV,RAIMG,RAFLD,RAMIS)) Q:RAMIS'>0 D Q:RAXIT
17 .... Q:RAMIS'<25&(RAMIS'=27)&(RAMIS'=99) S RAPRC=""
18 .... F S RAPRC=$O(^TMP($J,"RA",RADIV,RAIMG,RAFLD,RAMIS,RAPRC)) Q:RAPRC']"" D Q:RAXIT
19 ..... D PRT1
20 ..... Q
21 .... Q
22 ... D:'RAXIT TOT
23 ... Q
24 .. D:'RAXIT IMGCHK^RALWKL2
25 .. Q
26 . D:'RAXIT&(RADIFLG(RADIV)>1) DIVCHK^RALWKL2
27 . Q
28 Q
29PRT1 ; Tabulate the data for non summary report, output the data.
30 S RATTL2=$G(^TMP($J,"RA",RADIV,RAIMG,RAFLD,RAMIS,RAPRC))
31 S RAWWU2=$P(RATTL2,"^",5),RATTL3=0 ; Total up the first four pieces.
32 F I=1:1:4 S RATTL3=RATTL3+$P(RATTL2,"^",I)
33 D:'RAPG HD Q:RAXIT
34 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HD Q:RAXIT
35 W !,$E(RAPRC,1,28),?30,$J(+$P(RATTL2,"^"),5),?36,$J(+$P(RATTL2,"^",2),5)
36 W ?42,$J(+$P(RATTL2,"^",3),5),?48,$J(+$P(RATTL2,"^",4),5)
37 W ?55,$J(RATTL3,5),?62,$J($S(RATTL1:(100*RATTL3)/RATTL1,1:0),5,1)
38 I $D(RAFL) D
39 . W ?68,$J(RAWWU2,5),?75,$J($S(RAWWU1:(RAWWU2*100)/RAWWU1,1:0),5,1)
40 . Q
41 Q
42TOT ; Total within Service, Ward, Clinic, etc.
43 I 'RATTL1,('RAWWU1) Q
44 I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() D:'RAXIT HD Q:RAXIT
45 W !!,$G(RATITLE)_" Total"
46 W ?30,$J(+$P(RATTL0,"^"),5),?36,$J(+$P(RATTL0,"^",2),5)
47 W ?42,$J(+$P(RATTL0,"^",3),5),?48,$J(+$P(RATTL0,"^",4),5)
48 W ?55,$J(RATTL1,5)
49 W:$D(RAFL) ?68,$J(RAWWU1,5)
50 W !,RALN N RA1 S RA1=$O(^TMP($J,"RA",RADIV,RAIMG,RAFLD))
51 I RA1]"" N RAFLD S RAFLD=RA1,RAXIT=$$EOS^RAUTL5() D:'RAXIT HD
52 Q
53HD ; Header
54 I RAPG!($E(IOST,1,2)="C-") W:$Y>0 @IOF
55 S RAPG=RAPG+1
56 W !?5,">>> "_RATITLE_" Workload Report <<<"
57 W ?70,"Page: ",RAPG
58 W !!?4,"Division: ",$S($D(^DIC(4,+RADIV,0)):$P(^(0),U,1),1:"UNKNOWN")
59 W:'$D(RADIVSUM) !,"Imaging Type: ",$S($D(^RA(79.2,+$P(RAIMG,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN")
60 W ?52,"For period: ",?64,BEGDATE("X"),?77,"to"
61 W !?4,"Run Date: ",RATDY,?64,ENDDATE("X")
62 W !!?32,"-------Examinations------",!?62,"% of" W:$D(RAFL) ?75," % of"
63 W !,$S('RASUM:"Procedure",1:RATITLE),?30," Inpt",?36," Opt"
64 W ?42," Res",?48,"Other",?55,"Total",?62,"Exams"
65 W:$D(RAFL) ?68," WWU",?75," WWU"
66 W !,RALN
67 W:$D(RADIVSUM) !?10,"(Division Summary)" ; set in DIVCHK^RALWKL2
68 W:$D(RAIMGSUM) !?10,"(Imaging Type Summary)" ; set in IMGCHK^RALWKL2
69 W:'$D(RADIVSUM)&('$D(RAIMGSUM))&('RASUM) !?10,RATITLE,": ",$G(RAFLD)
70 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
71 Q
72DISPXAM(A) ; Display Examination Statuses which meet certain criteria.
73 ; 'A' is the equivalent of the variable 'RACRT'. This code is related
74 ; to the 'CRIT^RAUTL1' subroutine. This sets up the RACRT local array
75 ; according to I-Type.
76 N RA,RAHD,UNDRLN,X,Y,Z
77 S RAHD(0)="The entries printed for this report will be based only"
78 S RAHD(1)="on exams that are in one of the following statuses:"
79 W !!?(IOM-$L(RAHD(0))\2),RAHD(0),!?(IOM-$L(RAHD(1))\2),RAHD(1)
80 S X="" F S X=$O(^TMP($J,"RA I-TYPE",X)) Q:X']"" D Q:RAXIT
81 . I $D(^RA(72,"AA",X)) K UNDRLN S Y="" D
82 .. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT W @IOF
83 .. S $P(UNDRLN,"-",($L(X)+1))="" W !!?10,X,!?10,UNDRLN
84 .. F S Y=$O(^RA(72,"AA",X,Y)) Q:Y']"" D Q:RAXIT
85 ... S Z=0 F S Z=$O(^RA(72,"AA",X,Y,Z)) Q:'Z D Q:RAXIT
86 .... S RA(0)=$G(^RA(72,Z,0)),RA(.3)=$G(^RA(72,Z,.3))
87 .... S RA(.3,A)=$P(RA(.3),"^",A)
88 .... I RA(0)]"",(RA(.3)]""),(RA(.3,A)]""),("Yy"[RA(.3,A)) D
89 ..... S RACRT(Z)=X ; Where 'X' is the I-Type
90 ..... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D
91 ...... W @IOF,!?10,X,!?10,UNDRLN
92 ...... Q
93 ..... W !?15,$P(RA(0),"^")
94 ..... Q
95 .... Q
96 ... Q
97 .. Q
98 . Q
99 Q
Note: See TracBrowser for help on using the repository browser.