| [613] | 1 | RALWKL1 ;HISC/GJC-Workload Reports By Functional Area ;4/12/96 10:18
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|---|
| 3 | EN1 ; 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
|
|---|
| 29 | PRT1 ; 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
|
|---|
| 42 | TOT ; 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
|
|---|
| 53 | HD ; 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
|
|---|
| 72 | DISPXAM(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
|
|---|
