- 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 Jan 18, 2025@03:38:23 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