source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMIS1.m@ 757

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1RAMIS1 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;4/15/96 10:25
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 S RADIVN(0)=""
4 F S RADIVN(0)=$O(^TMP($J,"RA D-TYPE",RADIVN(0))) Q:RADIVN(0)="" D
5 . S RADIVN=0
6 . F S RADIVN=$O(^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN)) Q:RADIVN'>0 D
7 .. I $O(^TMP($J,"RAMIS",RADIVN,""))="" S ^TMP($J,"RAMIS",RADIVN)=""
8 .. Q
9 . Q
10 S (RACNT,RADATA)=0,PAGE=1
11 F RADIV=0:0 S RADIV=$O(^TMP($J,"RAMIS",RADIV)) Q:RADIV'>0!RAXIT S Y=$S($D(^DIC(4,RADIV,0)):$P(^(0),"^"),1:"UNKNOWN") S RACNT=RACNT+1 D PRT
12 I RADATA'>0!(RAXIT) G Q
13 I 'RAXIT,RACNT>1 S RADIV="TOT",Y="ALL DIVISIONS" D PRT
14Q K ^TMP($J,"RA D-TYPE"),^TMP($J,"RAMIS"),%DT,A,BEGDATE,C,D,ENDDATE,I,IN,J,OUT,PAGE,RA,RA20,RA21H,RA21B,RABEG,RACNI,RACNT,RACRT,RAD0,RADATA,RADFLAG,RADFN,RADIV,RADIVN
15 K RADTE,RADTI,RAEND,RAI,RAIN,RAINTOT,RAMIS,RAMUL,RAOR,RAOUT,RAOUTOT,RAP,RAP0,RAPOP,RAPORT,RAPRC,RAPRI,RAQI,RAQUIT,RASTAT,RATOT,RAVST,RAWT,RAXIT,RAZ,T,TOT,X,Y,Z,ZTRTN,ZTSAVE
16 K:$D(RAPSTX) RACCESS,RAPSTX
17 W ! D CLOSE^RAUTL
18 K DDH,POP,DUOUT,RAMES,ZTDESC
19 Q
20 ;
21PRT F T="EX","WT" S RAINTOT(T)=$G(^TMP($J,"RAMIS",RADIV,"TOT",T,"IN")),RAOUTOT(T)=$G(^("OUT")),RATOT(T)=RAINTOT(T)+RAOUTOT(T)
22 D HD1 Q:RAXIT
23 I $O(^TMP($J,"RAMIS",RADIV,""))="" D Q
24 . W !!,"No data for selected date range."
25 . I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5()
26 . Q
27 S RADATA=1
28 F RAMIS=0:0 S RAMIS=$O(^TMP($J,"RAMIS",RADIV,RAMIS)) Q:RAMIS'>0!RAXIT I RAMIS<25!(RAMIS=99)!(RAMIS=27) D PRT1
29 Q:RAXIT
30 W !!?5,"TOTALS",?45,$J(RAINTOT("EX"),5),?52,$J(RAOUTOT("EX"),5),?59,$J(RATOT("EX"),5),?74,$J(RAINTOT("WT"),5),?81,$J(RAOUTOT("WT"),5),?88,$J(RATOT("WT"),5)
31 S RAXIT=$$EOS("HD1") Q:RAXIT
32 S IN=RAINTOT("EX"),OUT=RAOUTOT("EX"),TOT=RATOT("EX")
33 W !?5,"AVERAGE WEIGHT PER EXAM",?74,$J($S(IN:(RAINTOT("WT")/IN),1:0),5,1),?81,$J($S(OUT:(RAOUTOT("WT")/OUT),1:0),5,1),?88,$J($S(TOT:(RATOT("WT")/TOT),1:0),5,1)
34 S RAXIT=$$EOS("HD1") Q:RAXIT
35 W ! F I=1:1:130 W "-"
36 S RAXIT=$$EOS("HD1") Q:RAXIT
37 F RAMIS=25,26,"MULP" D PRT1 Q:RAXIT
38 Q:RAXIT
39 I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5() Q:RAXIT
40 D HD2 Q:RAXIT
41 S RAXIT=$$EOS("HD2") Q:RAXIT
42 W !?4,"*CINE RUNS",?45,$J(^TMP($J,"RAMIS",RADIV,"CINERUNS","IN"),5),?52,$J(^("OUT"),5),?59,$J((^("IN")+^("OUT")),5)
43 S RAXIT=$$EOS("HD2") Q:RAXIT
44 W !?4,"*NO. OF CINE FEET USED",?45,$J(^TMP($J,"RAMIS",RADIV,"CINE","IN"),5),?52,$J(^("OUT"),5),?59,$J((^("IN")+^("OUT")),5)
45 S RAXIT=$$EOS("HD2") Q:RAXIT
46 W !?4,"*NO. OF FILMS USED",?45,$J(^TMP($J,"RAMIS",RADIV,"FLM","IN"),5),?52,$J(^("OUT"),5),?59,$J((^("IN")+^("OUT")),5)
47 S RAXIT=$$EOS("HD2") Q:RAXIT
48 S IN=^TMP($J,"RAMIS",RADIV,"VST","IN"),OUT=^("OUT"),TOT=IN+OUT
49 W !?5,"PATIENT VISITS",?45,$J(IN,5),?52,$J(OUT,5),?59,$J(TOT,5)
50 S RAXIT=$$EOS("HD2") Q:RAXIT
51 W !?5,"AVERAGE EXAMS PER VISIT",?45,$J($S(IN:(RAINTOT("EX")/IN),1:0),5,1),?52,$J($S(OUT:(RAOUTOT("EX")/OUT),1:0),5,1),?59,$J($S(TOT:(RATOT("EX")/TOT),1:0),5,1)
52 S RAXIT=$$EOS("HD2") Q:RAXIT
53 W !?5,"AVERAGE WORK UNITS PER VISIT",?45,$J($S(IN:(RAINTOT("WT")/IN),1:0),5,1),?52,$J($S(OUT:(RAOUTOT("WT")/OUT),1:0),5,1),?59,$J($S(TOT:(RATOT("WT")/TOT),1:0),5,1)
54 S RAXIT=$$EOS("HD2") Q:RAXIT
55 W !!!,"* These data are not to be used for AMIS. Use your inventory data."
56 I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5()
57 Q
58 ;
59PRT1 F T="EX","WT" S RAIN(T)=^TMP($J,"RAMIS",RADIV,RAMIS,T,"IN"),RAOUT(T)=^("OUT"),RA(T)=RAIN(T)+RAOUT(T),RAP(T)=$S(RATOT(T):100*(RA(T)/RATOT(T)),1:0)
60 W !?1,$S(RAMIS:RAMIS,RAMIS="MULP":""),?5,$S($D(^RAMIS(71.1,RAMIS,0)):$P(^(0),"^"),RAMIS="MULP":"SERIES OF AMIS CODES",1:"UNKNOWN") W:RAMIS<25!(RAMIS=99)!(RAMIS=27) ?38,$J($S($D(^(0)):$P(^(0),"^",2),1:""),3)
61 W ?45,$J(RAIN("EX"),5),?52,$J(RAOUT("EX"),5),?59,$J(RA("EX"),5),?64,$J(RAP("EX"),7,1)
62 W ?74,$J(RAIN("WT"),5),?81,$J(RAOUT("WT"),5),?88,$J(RA("WT"),5),?93,$J(RAP("WT"),7,1)
63 S RAXIT=$$EOS("HD1")
64 Q
65NONE W @IOF,!?45,">>> Overall Workload Report <<<"
66 W !!?5,"No exams registered for time period " N Y S Y=BEGDATE D D^RAUTL W Y," to " S Y=ENDDATE D D^RAUTL W Y,".",!
67 Q
68 ;
69HD1 I (PAGE>1)!($E(IOST,1,2)="C-") W @IOF
70 W !?45,">>> Overall Workload Report <<<",?115,"Page: ",PAGE
71 W !?1,"Division: ",Y,?95,"For period: " N Y S Y=BEGDATE D D^RAUTL W ?109,Y,?121,"to"
72 S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL W !?1,"Run Date: ",Y S Y=ENDDATE D D^RAUTL W ?109,Y
73 W !!?50,"Examinations",?78,"Weighted Work Units"
74 W !?5,"Amis Category",?37,"Weight",?45," IN",?52," OUT",?59,"TOTAL",?66," %",?74," IN",?81," OUT",?88,"TOTAL",?95," %"
75 S PAGE=PAGE+1
76 W ! F I=1:1:130 W "-"
77 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
78 Q
79HD2 I $E(IOST,1,2)="C-" W @IOF
80 W !!!?48,"Other Statistics",!?5,"Statistic Item",?45," IN",?52," OUT",?59,"TOTAL" W ! F I=1:1:130 W "-"
81 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
82 Q
83EOS(HDR) ; Generate the header passed in by the application
84 N RAXIT S RAXIT=0
85 I $Y>(IOSL-4) D
86 . N HOLDY S HOLDY=Y
87 . S RAXIT=$$EOS^RAUTL5()
88 . I 'RAXIT,$G(HDR)]"" S Y=HOLDY D @HDR
89 Q RAXIT
Note: See TracBrowser for help on using the repository browser.