Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAMIS1

RAMIS1.m

Go to the documentation of this file.
  1. RAMIS1 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;4/15/96 10:25
  1. ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. S RADIVN(0)=""
  1. F S RADIVN(0)=$O(^TMP($J,"RA D-TYPE",RADIVN(0))) Q:RADIVN(0)="" D
  1. . S RADIVN=0
  1. . F S RADIVN=$O(^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN)) Q:RADIVN'>0 D
  1. .. I $O(^TMP($J,"RAMIS",RADIVN,""))="" S ^TMP($J,"RAMIS",RADIVN)=""
  1. .. Q
  1. . Q
  1. S (RACNT,RADATA)=0,PAGE=1
  1. 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
  1. I RADATA'>0!(RAXIT) G Q
  1. I 'RAXIT,RACNT>1 S RADIV="TOT",Y="ALL DIVISIONS" D PRT
  1. Q 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
  1. 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
  1. K:$D(RAPSTX) RACCESS,RAPSTX
  1. W ! D CLOSE^RAUTL
  1. K DDH,POP,DUOUT,RAMES,ZTDESC
  1. Q
  1. ;
  1. PRT 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)
  1. D HD1 Q:RAXIT
  1. I $O(^TMP($J,"RAMIS",RADIV,""))="" D Q
  1. . W !!,"No data for selected date range."
  1. . I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5()
  1. . Q
  1. S RADATA=1
  1. 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
  1. Q:RAXIT
  1. 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)
  1. S RAXIT=$$EOS("HD1") Q:RAXIT
  1. S IN=RAINTOT("EX"),OUT=RAOUTOT("EX"),TOT=RATOT("EX")
  1. 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)
  1. S RAXIT=$$EOS("HD1") Q:RAXIT
  1. W ! F I=1:1:130 W "-"
  1. S RAXIT=$$EOS("HD1") Q:RAXIT
  1. F RAMIS=25,26,"MULP" D PRT1 Q:RAXIT
  1. Q:RAXIT
  1. I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5() Q:RAXIT
  1. D HD2 Q:RAXIT
  1. S RAXIT=$$EOS("HD2") Q:RAXIT
  1. W !?4,"*CINE RUNS",?45,$J(^TMP($J,"RAMIS",RADIV,"CINERUNS","IN"),5),?52,$J(^("OUT"),5),?59,$J((^("IN")+^("OUT")),5)
  1. S RAXIT=$$EOS("HD2") Q:RAXIT
  1. 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)
  1. S RAXIT=$$EOS("HD2") Q:RAXIT
  1. W !?4,"*NO. OF FILMS USED",?45,$J(^TMP($J,"RAMIS",RADIV,"FLM","IN"),5),?52,$J(^("OUT"),5),?59,$J((^("IN")+^("OUT")),5)
  1. S RAXIT=$$EOS("HD2") Q:RAXIT
  1. S IN=^TMP($J,"RAMIS",RADIV,"VST","IN"),OUT=^("OUT"),TOT=IN+OUT
  1. W !?5,"PATIENT VISITS",?45,$J(IN,5),?52,$J(OUT,5),?59,$J(TOT,5)
  1. S RAXIT=$$EOS("HD2") Q:RAXIT
  1. 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)
  1. S RAXIT=$$EOS("HD2") Q:RAXIT
  1. 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)
  1. S RAXIT=$$EOS("HD2") Q:RAXIT
  1. W !!!,"* These data are not to be used for AMIS. Use your inventory data."
  1. I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5()
  1. Q
  1. ;
  1. PRT1 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)
  1. 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)
  1. W ?45,$J(RAIN("EX"),5),?52,$J(RAOUT("EX"),5),?59,$J(RA("EX"),5),?64,$J(RAP("EX"),7,1)
  1. W ?74,$J(RAIN("WT"),5),?81,$J(RAOUT("WT"),5),?88,$J(RA("WT"),5),?93,$J(RAP("WT"),7,1)
  1. S RAXIT=$$EOS("HD1")
  1. Q
  1. NONE W @IOF,!?45,">>> Overall Workload Report <<<"
  1. 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,".",!
  1. Q
  1. ;
  1. HD1 I (PAGE>1)!($E(IOST,1,2)="C-") W @IOF
  1. W !?45,">>> Overall Workload Report <<<",?115,"Page: ",PAGE
  1. W !?1,"Division: ",Y,?95,"For period: " N Y S Y=BEGDATE D D^RAUTL W ?109,Y,?121,"to"
  1. 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
  1. W !!?50,"Examinations",?78,"Weighted Work Units"
  1. W !?5,"Amis Category",?37,"Weight",?45," IN",?52," OUT",?59,"TOTAL",?66," %",?74," IN",?81," OUT",?88,"TOTAL",?95," %"
  1. S PAGE=PAGE+1
  1. W ! F I=1:1:130 W "-"
  1. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
  1. Q
  1. HD2 I $E(IOST,1,2)="C-" W @IOF
  1. W !!!?48,"Other Statistics",!?5,"Statistic Item",?45," IN",?52," OUT",?59,"TOTAL" W ! F I=1:1:130 W "-"
  1. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
  1. Q
  1. EOS(HDR) ; Generate the header passed in by the application
  1. N RAXIT S RAXIT=0
  1. I $Y>(IOSL-4) D
  1. . N HOLDY S HOLDY=Y
  1. . S RAXIT=$$EOS^RAUTL5()
  1. . I 'RAXIT,$G(HDR)]"" S Y=HOLDY D @HDR
  1. Q RAXIT