source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPRC1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1RAPRC1 ;HISC/FPT AISC/MJK-Procedure Workload Report ;10/21/97 09:08
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4 S Y=BEGDATE D D^RAUTL S BEGDATE=Y
5 S Y=ENDDATE D D^RAUTL S ENDDATE=Y
6 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDTE=Y
7 S RA80DASH=$$REPEAT^XLFSTR("-",79),(PAGE,RAEOS)=0
8 F RADIV=0:0 S RADIV=$O(^TMP($J,"RA",RADIV)) Q:RAEOS!(RADIV'>0) S RAZ=^(RADIV),RAY=$S($D(^DIC(4,RADIV,0)):$P(^(0),"^"),1:"UNKNOWN") D RAMIS Q:RAEOS S RASUM="",Z=RAZ D HD Q:RAEOS D DIV K RASUM
9Q ; kill variables, close device
10 K ^TMP($J,"RA"),^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE"),^TMP($J,"RAPRC"),^TMP($J,"DIV-IMG")
11 K %DT,A,A1,BEGDATE,C,DDH,ENDDATE,I,J,IN,OUT,PAGE,RA80DASH,RABEG,RACNI,RACRT,RAD0,RAEOS,RADFN,RADIV,RADTE,RADTI,RAEND,RAFL,RAI,RAIN,RAITNUM,RAITYPE,RAMIS,RAMUL
12 K RANUM,RAOR,RAOUT,RAP0,RAPOP,RAPORT,RAQUIT,RAPRC,RAPRI,RAQI,RARUNDTE,RASTAT,RASUM,RATOT,RAWT,RAWWU,RAXIT,RAY,RAZ,TOT,WWU,X,Y,Z
13 K:$D(RAPSTX) RACCESS,RAPSTX
14 W ! D CLOSE^RAUTL
15 K DUOUT,POP,RAMES,ZTDESC,ZTSAVE
16 Q
17 ;
18RAMIS S RAMIS=0 F J=0:0 S RAMIS=$O(^TMP($J,"RA",RADIV,RAMIS)) Q:RAEOS!(RAMIS="") S Z=^(RAMIS) D HD Q:RAEOS D PRT
19 Q
20 ;
21PRT S IN=$P(Z,"^"),OUT=$P(Z,"^",2),TOT=IN+OUT,WWU=$P(Z,"^",3)
22 S RAPRC="" F I=0:0 S RAPRC=$O(^TMP($J,"RA",RADIV,RAMIS,RAPRC)) Q:RAPRC="" S Y=^(RAPRC),RAIN=$P(Y,"^"),RAOUT=$P(Y,"^",2),RAWWU=$P(Y,"^",3),RATOT=RAIN+RAOUT D PRT1
23 W !!?2,$S($D(RASUM):"DIVISION",1:"AMIS CATEGORY")," TOTALS",?35,$J(IN,5),?42,$J(OUT,5),?49,$J(TOT,5),?63,$J(WWU,5)
24 S RAEOS=$$EOS^RAUTL5()
25 Q
26PRT1 I ($Y+4)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D HD Q:RAEOS
27 W !?2,RAPRC,?35,$J(RAIN,5),?42,$J(RAOUT,5),?49,$J(RATOT,5),?56,$J($S(TOT:(100*RATOT)/TOT,1:0),5,1),?63,$J(RAWWU,5),?70,$J($S(WWU:(RAWWU*100)/WWU,1:0),5,1)
28 Q
29 ;
30HD W:$Y>0 @IOF W !?9,">>>>> Detailed Procedure Workload Report <<<<<" S PAGE=PAGE+1 W ?70,"Page: ",PAGE
31 W !!?5,"Division: ",RAY
32 W !?1,"Imaging Type: ",RAITYPE,?52,"For period: " W ?64,BEGDATE,?76,"to",!?5,"Run Date: ",RARUNDTE,?64,ENDDATE
33 W !!?40,$S(RAMIS="MULP":"No. of Series",1:"Examinations"),?56,"Percent",?70,"Percent"
34 W !?2,$S('$D(RASUM):"Procedure",1:"Amis Category"),?35," In",?42," Out",?49,"Total",?56,$S(RAMIS="MULP":"Series",1:" Exams"),?63," WWU",?70," WWU"
35 W !,RA80DASH
36 W:$D(RASUM) !?10,"(Division Summary)" W:'$D(RASUM) !?5,"Amis: ",$S(RAMIS:RAMIS,1:""),?15,$S($D(^RAMIS(71.1,RAMIS,0)):$P(^(0),"^"),RAMIS="MULP":"SERIES OF AMIS CODES",1:"UNKNOWN")
37 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1
38 Q
39 ;
40DIV S IN=$P(Z,"^"),OUT=$P(Z,"^",2),TOT=IN+OUT,WWU=$P(Z,"^",3)
41 F I=0:0 S RAMIS=$O(^TMP($J,"RA",RADIV,RAMIS)) Q:RAEOS!(RAMIS="") I RAMIS'="MULP",RAMIS<25!(RAMIS=99) S Y=^(RAMIS),RAIN=$P(Y,"^"),RAOUT=$P(Y,"^",2),RAWWU=$P(Y,"^",3),RATOT=RAIN+RAOUT D DIV1 Q:RAEOS
42 W !!?2,"DIVISION TOTALS",?35,$J(IN,5),?42,$J(OUT,5),?49,$J(TOT,5),?63,$J(WWU,5)
43 W !!,RA80DASH
44 F RAMIS=25,26,"MULP" I $D(^TMP($J,"RA",RADIV,RAMIS)) S Y=^(RAMIS),RAIN=$P(Y,"^"),RAOUT=$P(Y,"^",2),RAWWU=$P(Y,"^",3),RATOT=RAIN+RAOUT D DIV1 Q:RAEOS
45 Q:RAEOS
46 I $O(^TMP($J,"RA",RADIV))]"" S RAEOS=$$EOS^RAUTL5()
47 Q
48DIV1 I ($Y+4)>IOSL S RAEOS=$$EOS^RAUTL5() Q:RAEOS D HD Q:RAEOS
49 W !,$J($S(RAMIS:RAMIS,1:" "),2),"-",$E($S($D(^RAMIS(71.1,RAMIS,0)):$P(^(0),"^"),RAMIS="MULP":"SERIES OF AMIS CODES",1:"UNKNOWN"),1,30)
50 W ?35,$J(RAIN,5),?42,$J(RAOUT,5),?49,$J(RATOT,5),?56,$S(RAMIS="MULP":"",1:$J($S(TOT:(100*RATOT)/TOT,1:0),5,1)),?63,$J(RAWWU,5),?70,$J($S(WWU:(RAWWU*100)/WWU,1:0),5,1)
51 Q
52SAVEONE ; Save off the I-Type
53 S RAITNUM=+$O(^TMP($J,"DIV-IMG",0))
54 S RAITYPE=$P($G(^RA(79.2,RAITNUM,0)),"^")
55 S ^TMP($J,"RA I-TYPE",RAITYPE,RAITNUM)=""
56 Q
Note: See TracBrowser for help on using the repository browser.