RAMIS1 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;4/15/96 10:25
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
S RADIVN(0)=""
F S RADIVN(0)=$O(^TMP($J,"RA D-TYPE",RADIVN(0))) Q:RADIVN(0)="" D
. S RADIVN=0
. F S RADIVN=$O(^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN)) Q:RADIVN'>0 D
.. I $O(^TMP($J,"RAMIS",RADIVN,""))="" S ^TMP($J,"RAMIS",RADIVN)=""
.. Q
. Q
S (RACNT,RADATA)=0,PAGE=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
I RADATA'>0!(RAXIT) G Q
I 'RAXIT,RACNT>1 S RADIV="TOT",Y="ALL DIVISIONS" D PRT
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
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
K:$D(RAPSTX) RACCESS,RAPSTX
W ! D CLOSE^RAUTL
K DDH,POP,DUOUT,RAMES,ZTDESC
Q
;
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)
D HD1 Q:RAXIT
I $O(^TMP($J,"RAMIS",RADIV,""))="" D Q
. W !!,"No data for selected date range."
. I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5()
. Q
S RADATA=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
Q:RAXIT
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)
S RAXIT=$$EOS("HD1") Q:RAXIT
S IN=RAINTOT("EX"),OUT=RAOUTOT("EX"),TOT=RATOT("EX")
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)
S RAXIT=$$EOS("HD1") Q:RAXIT
W ! F I=1:1:130 W "-"
S RAXIT=$$EOS("HD1") Q:RAXIT
F RAMIS=25,26,"MULP" D PRT1 Q:RAXIT
Q:RAXIT
I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5() Q:RAXIT
D HD2 Q:RAXIT
S RAXIT=$$EOS("HD2") Q:RAXIT
W !?4,"*CINE RUNS",?45,$J(^TMP($J,"RAMIS",RADIV,"CINERUNS","IN"),5),?52,$J(^("OUT"),5),?59,$J((^("IN")+^("OUT")),5)
S RAXIT=$$EOS("HD2") Q:RAXIT
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)
S RAXIT=$$EOS("HD2") Q:RAXIT
W !?4,"*NO. OF FILMS USED",?45,$J(^TMP($J,"RAMIS",RADIV,"FLM","IN"),5),?52,$J(^("OUT"),5),?59,$J((^("IN")+^("OUT")),5)
S RAXIT=$$EOS("HD2") Q:RAXIT
S IN=^TMP($J,"RAMIS",RADIV,"VST","IN"),OUT=^("OUT"),TOT=IN+OUT
W !?5,"PATIENT VISITS",?45,$J(IN,5),?52,$J(OUT,5),?59,$J(TOT,5)
S RAXIT=$$EOS("HD2") Q:RAXIT
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)
S RAXIT=$$EOS("HD2") Q:RAXIT
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)
S RAXIT=$$EOS("HD2") Q:RAXIT
W !!!,"* These data are not to be used for AMIS. Use your inventory data."
I $E(IOST,1,2)="C-" S RAXIT=$$EOS^RAUTL5()
Q
;
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)
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)
W ?45,$J(RAIN("EX"),5),?52,$J(RAOUT("EX"),5),?59,$J(RA("EX"),5),?64,$J(RAP("EX"),7,1)
W ?74,$J(RAIN("WT"),5),?81,$J(RAOUT("WT"),5),?88,$J(RA("WT"),5),?93,$J(RAP("WT"),7,1)
S RAXIT=$$EOS("HD1")
Q
NONE W @IOF,!?45,">>> Overall Workload Report <<<"
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,".",!
Q
;
HD1 I (PAGE>1)!($E(IOST,1,2)="C-") W @IOF
W !?45,">>> Overall Workload Report <<<",?115,"Page: ",PAGE
W !?1,"Division: ",Y,?95,"For period: " N Y S Y=BEGDATE D D^RAUTL W ?109,Y,?121,"to"
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
W !!?50,"Examinations",?78,"Weighted Work Units"
W !?5,"Amis Category",?37,"Weight",?45," IN",?52," OUT",?59,"TOTAL",?66," %",?74," IN",?81," OUT",?88,"TOTAL",?95," %"
S PAGE=PAGE+1
W ! F I=1:1:130 W "-"
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
Q
HD2 I $E(IOST,1,2)="C-" W @IOF
W !!!?48,"Other Statistics",!?5,"Statistic Item",?45," IN",?52," OUT",?59,"TOTAL" W ! F I=1:1:130 W "-"
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
Q
EOS(HDR) ; Generate the header passed in by the application
N RAXIT S RAXIT=0
I $Y>(IOSL-4) D
. N HOLDY S HOLDY=Y
. S RAXIT=$$EOS^RAUTL5()
. I 'RAXIT,$G(HDR)]"" S Y=HOLDY D @HDR
Q RAXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMIS1 4967 printed Nov 22, 2024@17:47:21 Page 2
RAMIS1 ;HISC/CAH,FPT,GJC-Radiology AMIS Report ;4/15/96 10:25
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 SET RADIVN(0)=""
+3 FOR
SET RADIVN(0)=$ORDER(^TMP($JOB,"RA D-TYPE",RADIVN(0)))
if RADIVN(0)=""
QUIT
Begin DoDot:1
+4 SET RADIVN=0
+5 FOR
SET RADIVN=$ORDER(^TMP($JOB,"RA D-TYPE",RADIVN(0),RADIVN))
if RADIVN'>0
QUIT
Begin DoDot:2
+6 IF $ORDER(^TMP($JOB,"RAMIS",RADIVN,""))=""
SET ^TMP($JOB,"RAMIS",RADIVN)=""
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 SET (RACNT,RADATA)=0
SET PAGE=1
+10 FOR RADIV=0:0
SET RADIV=$ORDER(^TMP($JOB,"RAMIS",RADIV))
if RADIV'>0!RAXIT
QUIT
SET Y=$SELECT($DATA(^DIC(4,RADIV,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
SET RACNT=RACNT+1
DO PRT
+11 IF RADATA'>0!(RAXIT)
GOTO Q
+12 IF 'RAXIT
IF RACNT>1
SET RADIV="TOT"
SET Y="ALL DIVISIONS"
DO PRT
Q KILL ^TMP($JOB,"RA D-TYPE"),^TMP($JOB,"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 KILL 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
+2 if $DATA(RAPSTX)
KILL RACCESS,RAPSTX
+3 WRITE !
DO CLOSE^RAUTL
+4 KILL DDH,POP,DUOUT,RAMES,ZTDESC
+5 QUIT
+6 ;
PRT FOR T="EX","WT"
SET RAINTOT(T)=$GET(^TMP($JOB,"RAMIS",RADIV,"TOT",T,"IN"))
SET RAOUTOT(T)=$GET(^("OUT"))
SET RATOT(T)=RAINTOT(T)+RAOUTOT(T)
+1 DO HD1
if RAXIT
QUIT
+2 IF $ORDER(^TMP($JOB,"RAMIS",RADIV,""))=""
Begin DoDot:1
+3 WRITE !!,"No data for selected date range."
+4 IF $EXTRACT(IOST,1,2)="C-"
SET RAXIT=$$EOS^RAUTL5()
+5 QUIT
End DoDot:1
QUIT
+6 SET RADATA=1
+7 FOR RAMIS=0:0
SET RAMIS=$ORDER(^TMP($JOB,"RAMIS",RADIV,RAMIS))
if RAMIS'>0!RAXIT
QUIT
IF RAMIS<25!(RAMIS=99)!(RAMIS=27)
DO PRT1
+8 if RAXIT
QUIT
+9 WRITE !!?5,"TOTALS",?45,$JUSTIFY(RAINTOT("EX"),5),?52,$JUSTIFY(RAOUTOT("EX"),5),?59,$JUSTIFY(RATOT("EX"),5),?74,$JUSTIFY(RAINTOT("WT"),5),?81,$JUSTIFY(RAOUTOT("WT"),5),?88,$JUSTIFY(RATOT("WT"),5)
+10 SET RAXIT=$$EOS("HD1")
if RAXIT
QUIT
+11 SET IN=RAINTOT("EX")
SET OUT=RAOUTOT("EX")
SET TOT=RATOT("EX")
+12 WRITE !?5,"AVERAGE WEIGHT PER EXAM",?74,$JUSTIFY($SELECT(IN:(RAINTOT("WT")/IN),1:0),5,1),?81,$JUSTIFY($SELECT(OUT:(RAOUTOT("WT")/OUT),1:0),5,1),?88,$JUSTIFY($SELECT(TOT:(RATOT("WT")/TOT),1:0),5,1)
+13 SET RAXIT=$$EOS("HD1")
if RAXIT
QUIT
+14 WRITE !
FOR I=1:1:130
WRITE "-"
+15 SET RAXIT=$$EOS("HD1")
if RAXIT
QUIT
+16 FOR RAMIS=25,26,"MULP"
DO PRT1
if RAXIT
QUIT
+17 if RAXIT
QUIT
+18 IF $EXTRACT(IOST,1,2)="C-"
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
+19 DO HD2
if RAXIT
QUIT
+20 SET RAXIT=$$EOS("HD2")
if RAXIT
QUIT
+21 WRITE !?4,"*CINE RUNS",?45,$JUSTIFY(^TMP($JOB,"RAMIS",RADIV,"CINERUNS","IN"),5),?52,$JUSTIFY(^("OUT"),5),?59,$JUSTIFY((^("IN")+^("OUT")),5)
+22 SET RAXIT=$$EOS("HD2")
if RAXIT
QUIT
+23 WRITE !?4,"*NO. OF CINE FEET USED",?45,$JUSTIFY(^TMP($JOB,"RAMIS",RADIV,"CINE","IN"),5),?52,$JUSTIFY(^("OUT"),5),?59,$JUSTIFY((^("IN")+^("OUT")),5)
+24 SET RAXIT=$$EOS("HD2")
if RAXIT
QUIT
+25 WRITE !?4,"*NO. OF FILMS USED",?45,$JUSTIFY(^TMP($JOB,"RAMIS",RADIV,"FLM","IN"),5),?52,$JUSTIFY(^("OUT"),5),?59,$JUSTIFY((^("IN")+^("OUT")),5)
+26 SET RAXIT=$$EOS("HD2")
if RAXIT
QUIT
+27 SET IN=^TMP($JOB,"RAMIS",RADIV,"VST","IN")
SET OUT=^("OUT")
SET TOT=IN+OUT
+28 WRITE !?5,"PATIENT VISITS",?45,$JUSTIFY(IN,5),?52,$JUSTIFY(OUT,5),?59,$JUSTIFY(TOT,5)
+29 SET RAXIT=$$EOS("HD2")
if RAXIT
QUIT
+30 WRITE !?5,"AVERAGE EXAMS PER VISIT",?45,$JUSTIFY($SELECT(IN:(RAINTOT("EX")/IN),1:0),5,1),?52,$JUSTIFY($SELECT(OUT:(RAOUTOT("EX")/OUT),1:0),5,1),?59,$JUSTIFY($SELECT(TOT:(RATOT("EX")/TOT),1:0),5,1)
+31 SET RAXIT=$$EOS("HD2")
if RAXIT
QUIT
+32 WRITE !?5,"AVERAGE WORK UNITS PER VISIT",?45,$JUSTIFY($SELECT(IN:(RAINTOT("WT")/IN),1:0),5,1),?52,$JUSTIFY($SELECT(OUT:(RAOUTOT("WT")/OUT),1:0),5,1),?59,$JUSTIFY($SELECT(TOT:(RATOT("WT")/TOT),1:0),5,1)
+33 SET RAXIT=$$EOS("HD2")
if RAXIT
QUIT
+34 WRITE !!!,"* These data are not to be used for AMIS. Use your inventory data."
+35 IF $EXTRACT(IOST,1,2)="C-"
SET RAXIT=$$EOS^RAUTL5()
+36 QUIT
+37 ;
PRT1 FOR T="EX","WT"
SET RAIN(T)=^TMP($JOB,"RAMIS",RADIV,RAMIS,T,"IN")
SET RAOUT(T)=^("OUT")
SET RA(T)=RAIN(T)+RAOUT(T)
SET RAP(T)=$SELECT(RATOT(T):100*(RA(T)/RATOT(T)),1:0)
+1 WRITE !?1,$SELECT(RAMIS:RAMIS,RAMIS="MULP":""),?5,$SELECT($DATA(^RAMIS(71.1,RAMIS,0)):$PIECE(^(0),"^"),RAMIS="MULP":"SERIES OF AMIS CODES",1:"UNKNOWN")
if RAMIS<25!(RAMIS=99)!(RAMIS=27)
WRITE ?38,$JUSTIFY($SELECT($DATA(^(0)):$PIECE(^(0),"^",2),1:""),3)
+2 WRITE ?45,$JUSTIFY(RAIN("EX"),5),?52,$JUSTIFY(RAOUT("EX"),5),?59,$JUSTIFY(RA("EX"),5),?64,$JUSTIFY(RAP("EX"),7,1)
+3 WRITE ?74,$JUSTIFY(RAIN("WT"),5),?81,$JUSTIFY(RAOUT("WT"),5),?88,$JUSTIFY(RA("WT"),5),?93,$JUSTIFY(RAP("WT"),7,1)
+4 SET RAXIT=$$EOS("HD1")
+5 QUIT
NONE WRITE @IOF,!?45,">>> Overall Workload Report <<<"
+1 WRITE !!?5,"No exams registered for time period "
NEW Y
SET Y=BEGDATE
DO D^RAUTL
WRITE Y," to "
SET Y=ENDDATE
DO D^RAUTL
WRITE Y,".",!
+2 QUIT
+3 ;
HD1 IF (PAGE>1)!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+1 WRITE !?45,">>> Overall Workload Report <<<",?115,"Page: ",PAGE
+2 WRITE !?1,"Division: ",Y,?95,"For period: "
NEW Y
SET Y=BEGDATE
DO D^RAUTL
WRITE ?109,Y,?121,"to"
+3 SET X="NOW"
SET %DT="T"
DO ^%DT
KILL %DT
DO D^RAUTL
WRITE !?1,"Run Date: ",Y
SET Y=ENDDATE
DO D^RAUTL
WRITE ?109,Y
+4 WRITE !!?50,"Examinations",?78,"Weighted Work Units"
+5 WRITE !?5,"Amis Category",?37,"Weight",?45," IN",?52," OUT",?59,"TOTAL",?66," %",?74," IN",?81," OUT",?88,"TOTAL",?95," %"
+6 SET PAGE=PAGE+1
+7 WRITE !
FOR I=1:1:130
WRITE "-"
+8 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
+9 QUIT
HD2 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+1 WRITE !!!?48,"Other Statistics",!?5,"Statistic Item",?45," IN",?52," OUT",?59,"TOTAL"
WRITE !
FOR I=1:1:130
WRITE "-"
+2 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
+3 QUIT
EOS(HDR) ; Generate the header passed in by the application
+1 NEW RAXIT
SET RAXIT=0
+2 IF $Y>(IOSL-4)
Begin DoDot:1
+3 NEW HOLDY
SET HOLDY=Y
+4 SET RAXIT=$$EOS^RAUTL5()
+5 IF 'RAXIT
IF $GET(HDR)]""
SET Y=HOLDY
DO @HDR
End DoDot:1
+6 QUIT RAXIT
