- RAWKL2 ;HISC/FPT-Workload Reports (cont.) ;12/27/00 11:29
- ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
- ; print report
- S PAGE=0,RADIV=""
- F S RADIV=$O(^TMP($J,"RA",RADIV)) Q:RADIV=""!($D(RAEOS)) S RAITYPE="" F S RAITYPE=$O(^TMP($J,"RA",RADIV,RAITYPE)) Q:RAITYPE=""!($D(RAEOS)) S RAZ=^(RAITYPE) D START
- Q ; kill variables, close device
- K ^TMP($J),A,A1,B,B1,BEGDATE,C,ENDDATE,I,IN,J,OUT,PAGE,POP,RA80DASH,RABEG,RACNI,RACPT,RACRT,RAD0,RADFN,RADIV,RADIVNME,RADTE,RADTI,RAEND,RAEOS,RAFILE,RAFL,RAFL1,RAFL3,RAFLD,RAFLDCNT,RAI,RAIN,RAINPUT,RAMIS,RAITCNT,RAITYPE
- K RAMUL,RANUM,RAOR,RAOUT,RAP0,RAPCE,RAPIFN,RAPOP,RAPORT,RAPRC,RAPRI,RAQI,RAQUIT,RARUNDTE,RASUM,RATITLE,RATOT,RASTAT,RASV,RATCI,RAWT,RAWWU,RAXIT,RAZ,TOT
- K %DT,DIROUT,DIRUT,DTOUT,DUOUT,RAMES,RACMLIST
- K WWU,X,Y,Z,ZTDESC,ZTRTN,ZTSAVE,ZZ,ZZZ
- K:$D(RAPSTX) RACCESS,RAPSTX
- W ! D CLOSE^RAUTL K POP
- Q
- START ;
- D:$D(RAFL1) RAFLD Q:$D(RAEOS)
- S RASUM="",Z=RAZ,ZZ=")",ZZZ="RAFLD"
- D HD Q:$D(RAEOS)
- D PRT Q:$D(RAEOS)
- D TOT K RASUM Q:$D(RAEOS)
- I $O(^TMP($J,"RA",RADIV,RAITYPE))="" D DIVTOT^RAWKL3
- Q
- RAFLD S RAFLD="" F J=0:0 S RAFLD=$O(^TMP($J,"RA",RADIV,RAITYPE,RAFLD)) Q:RAFLD=""!($D(RAEOS)) S Z=^(RAFLD) D HD Q:$D(RAEOS) D RAMIS
- Q
- RAMIS ;
- S RAMIS=0
- F S RAMIS=$O(^TMP($J,"RA",RADIV,RAITYPE,RAFLD,RAMIS)) D:RAMIS'>0 TOT Q:RAMIS'>0!($D(RAEOS)) S ZZ=",RAMIS,RAPRC)",ZZZ="RAPRC" D:RAMIS<25!(RAMIS=99)!(RAMIS=27) PRT
- Q
- PRT ;
- I ($Y+4)>IOSL D EOS Q:$D(RAEOS) D HD Q:$D(RAEOS)
- S IN=$P(Z,"^"),OUT=$P(Z,"^",2),TOT=IN+OUT,WWU=$P(Z,"^",3),@ZZZ=""
- F I=0:0 S @ZZZ=$O(@("^TMP($J,""RA"",RADIV,RAITYPE,RAFLD"_ZZ)) Q:@ZZZ=""!($D(RAEOS)) S Y=^(@ZZZ),RAIN=$P(Y,"^"),RAOUT=$P(Y,"^",2),RAWWU=$P(Y,"^",3),RATOT=RAIN+RAOUT D PRT1
- Q
- TOT ;
- W !,RA80DASH
- I '$G(RACMLIST) W !!?2,$S($D(RASUM):"Imaging Type",1:RATITLE)," Total",?40,$J(IN,5),?47,$J(OUT,5),?54,$J(TOT,5) W:$D(RAFL) ?68,$J(WWU,5)
- I $G(RACMLIST),'$D(RASUM) W !!?2,RATITLE," Total",?50,$J(IN,5),?57,$J(OUT,5),?64,$J(TOT,5)
- I $G(RACMLIST),$D(RASUM) W !!?2,"Imaging Type"," Total",?40,$J(IN,5),?47,$J(OUT,5),?54,$J(TOT,5) W:$D(RAFL) ?68,$J(WWU,5)
- I ($Y+4)>IOSL D EOS Q:$D(RAEOS) Q:'$D(RASUM) D HD Q:$D(RAEOS)
- I $D(RASUM),'RAPCE D
- .I TOT>0 D Q
- ..W !!!?2,"NOTE: Since a procedure can be performed by more than one technologist,",!?8,"the total number of exams and weighted work units by division and",!?8,"imaging type is likely to be higher than the other workload reports."
- ..Q
- I $D(RASUM)&(RAPCE=12!(RAPCE=15)) D
- .I TOT>0 D Q
- ..W:RAPRIM=0 !!!?2,"NOTE: Since a procedure can be performed by more than one Interpreting ",!?8,$S(RAPCE=12:"Resident",1:"Staff"),", the total number of exams by division and imaging type"
- ..W:RAPRIM=0 !?8,"is likely to be higher than the other workload reports."
- ..W:RAPRIM=0 !?8,"Both Primary and Secondary Interpreting "_$P(RATITLE," ",2)_" are included in",!?8,"this report."
- ..W:RAPRIM=1 !!?2,"NOTE: Only Primary Interpreting "_$S($P(RATITLE," ",2)="Resident":"Residents",1:"Staff")_" are included in this report."
- ..Q
- .Q
- I ($Y+4)>IOSL D EOS Q:$D(RAEOS) D HD Q:$D(RAEOS)
- I $D(RASUM),($P(RATITLE," ")'="Interpreting") W !!?3,"# of "_RATITLE_"s selected: "_$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))
- I $D(RASUM),($P(RATITLE," ")="Interpreting") D
- . W !!?3,"# of "_$S($G(RAPRIM)=1:"Primary ",1:"")_$S($P(RATITLE," ",2)="Resident":"Residents",1:"Staff")_" selected: "_$S(RAINPUT=1:"ALL",1:$G(RAFLDCNT))
- . Q
- I $D(RASUM),$O(^TMP($J,"RA",RADIV))="",RAITCNT(RADIV)=1 Q
- D EOS
- Q
- PRT1 ;
- I ($Y+4)>IOSL D EOS Q:$D(RAEOS) D HD Q:$D(RAEOS)
- W:'$G(RACMLIST) !,@ZZZ,?40,$J(RAIN,5),?47,$J(RAOUT,5),?54,$J(RATOT,5),?61,$J($S(TOT:(100*RATOT)/TOT,1:0),5,1) W:$D(RAFL) ?68,$J(RAWWU,5),?75,$J($S(WWU:(RAWWU*100)/WWU,1:0),5,1)
- I $G(RACMLIST),'$D(RASUM) W !,@ZZZ,?50,$J(RAIN,5),?57,$J(RAOUT,5),?64,$J(RATOT,5),?71,$J($S(TOT:(100*RATOT)/TOT,1:0),5,1)
- I $G(RACMLIST),$D(RASUM) W !,@ZZZ,?40,$J(RAIN,5),?47,$J(RAOUT,5),?54,$J(RATOT,5),?61,$J($S(TOT:(100*RATOT)/TOT,1:0),5,1)
- Q
- HD ; header
- W:$Y>0 @IOF W !?10,">>> ",RATITLE," Workload Report <<<" S PAGE=PAGE+1 W ?70,"Page: ",PAGE
- W !!?4,"Division: ",$S($D(^DIC(4,+RADIV,0)):$P(^(0),U,1),1:"UNKNOWN"),!,"Imaging Type: ",$S($D(^RA(79.2,+$P(RAITYPE,"-",2),0)):$P(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"
- W !?4,"Run Date: ",RARUNDTE,?64,ENDDATE
- W:'$G(RACMLIST) !!?45,"Examinations",?61,"Percent" W:$D(RAFL) ?73,"Percent"
- I $G(RACMLIST),'$D(RASUM) W !!?55,"Examinations",?71,"Percent"
- I $G(RACMLIST),$D(RASUM) W !!?45,"Examinations",?61,"Percent"
- W:'$G(RACMLIST) !?2,$S('$D(RASUM):"Procedure (CPT)",1:RATITLE),?40," In",?47," Out",?54,"Total",?61," Exams" W:$D(RAFL) ?67," WWU",?73," WWU"
- I $G(RACMLIST),'$D(RASUM) W !?2,"Procedure (CPT) (* : > 3 CPT mods)",?50," In",?57," Out",?64,"Total",?71," Exams"
- I $G(RACMLIST),$D(RASUM) W !?2,RATITLE,?40," In",?47," Out",?54,"Total",?61," Exams"
- W !,RA80DASH
- W:'$D(RASUM) !?10,RATITLE,": ",RAFLD
- W:$D(RASUM) !,?10,"(Imaging Type Summary)"
- I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1
- Q
- EOS ; end of screen
- S X=$$EOS^RAUTL5()
- S:X=1 RAEOS=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAWKL2 5116 printed Feb 19, 2025@00:06:58 Page 2
- RAWKL2 ;HISC/FPT-Workload Reports (cont.) ;12/27/00 11:29
- +1 ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
- +2 ; print report
- +3 SET PAGE=0
- SET RADIV=""
- +4 FOR
- SET RADIV=$ORDER(^TMP($JOB,"RA",RADIV))
- if RADIV=""!($DATA(RAEOS))
- QUIT
- SET RAITYPE=""
- FOR
- SET RAITYPE=$ORDER(^TMP($JOB,"RA",RADIV,RAITYPE))
- if RAITYPE=""!($DATA(RAEOS))
- QUIT
- SET RAZ=^(RAITYPE)
- DO START
- Q ; kill variables, close device
- +1 KILL ^TMP($JOB),A,A1,B,B1,BEGDATE,C,ENDDATE,I,IN,J,OUT,PAGE,POP,RA80DASH,RABEG,RACNI,RACPT,RACRT,RAD0,RADFN,RADIV,RADIVNME,RADTE,RADTI,RAEND,RAEOS,RAFILE,RAFL,RAFL1,RAFL3,RAFLD,RAFLDCNT,RAI,RAIN,RAINPUT,RAMIS,RAITCNT,RAITYPE
- +2 KILL RAMUL,RANUM,RAOR,RAOUT,RAP0,RAPCE,RAPIFN,RAPOP,RAPORT,RAPRC,RAPRI,RAQI,RAQUIT,RARUNDTE,RASUM,RATITLE,RATOT,RASTAT,RASV,RATCI,RAWT,RAWWU,RAXIT,RAZ,TOT
- +3 KILL %DT,DIROUT,DIRUT,DTOUT,DUOUT,RAMES,RACMLIST
- +4 KILL WWU,X,Y,Z,ZTDESC,ZTRTN,ZTSAVE,ZZ,ZZZ
- +5 if $DATA(RAPSTX)
- KILL RACCESS,RAPSTX
- +6 WRITE !
- DO CLOSE^RAUTL
- KILL POP
- +7 QUIT
- START ;
- +1 if $DATA(RAFL1)
- DO RAFLD
- if $DATA(RAEOS)
- QUIT
- +2 SET RASUM=""
- SET Z=RAZ
- SET ZZ=")"
- SET ZZZ="RAFLD"
- +3 DO HD
- if $DATA(RAEOS)
- QUIT
- +4 DO PRT
- if $DATA(RAEOS)
- QUIT
- +5 DO TOT
- KILL RASUM
- if $DATA(RAEOS)
- QUIT
- +6 IF $ORDER(^TMP($JOB,"RA",RADIV,RAITYPE))=""
- DO DIVTOT^RAWKL3
- +7 QUIT
- RAFLD SET RAFLD=""
- FOR J=0:0
- SET RAFLD=$ORDER(^TMP($JOB,"RA",RADIV,RAITYPE,RAFLD))
- if RAFLD=""!($DATA(RAEOS))
- QUIT
- SET Z=^(RAFLD)
- DO HD
- if $DATA(RAEOS)
- QUIT
- DO RAMIS
- +1 QUIT
- RAMIS ;
- +1 SET RAMIS=0
- +2 FOR
- SET RAMIS=$ORDER(^TMP($JOB,"RA",RADIV,RAITYPE,RAFLD,RAMIS))
- if RAMIS'>0
- DO TOT
- if RAMIS'>0!($DATA(RAEOS))
- QUIT
- SET ZZ=",RAMIS,RAPRC)"
- SET ZZZ="RAPRC"
- if RAMIS<25!(RAMIS=99)!(RAMIS=27)
- DO PRT
- +3 QUIT
- PRT ;
- +1 IF ($Y+4)>IOSL
- DO EOS
- if $DATA(RAEOS)
- QUIT
- DO HD
- if $DATA(RAEOS)
- QUIT
- +2 SET IN=$PIECE(Z,"^")
- SET OUT=$PIECE(Z,"^",2)
- SET TOT=IN+OUT
- SET WWU=$PIECE(Z,"^",3)
- SET @ZZZ=""
- +3 FOR I=0:0
- SET @ZZZ=$ORDER(@("^TMP($J,""RA"",RADIV,RAITYPE,RAFLD"_ZZ))
- if @ZZZ=""!($DATA(RAEOS))
- QUIT
- SET Y=^(@ZZZ)
- SET RAIN=$PIECE(Y,"^")
- SET RAOUT=$PIECE(Y,"^",2)
- SET RAWWU=$PIECE(Y,"^",3)
- SET RATOT=RAIN+RAOUT
- DO PRT1
- +4 QUIT
- TOT ;
- +1 WRITE !,RA80DASH
- +2 IF '$GET(RACMLIST)
- WRITE !!?2,$SELECT($DATA(RASUM):"Imaging Type",1:RATITLE)," Total",?40,$JUSTIFY(IN,5),?47,$JUSTIFY(OUT,5),?54,$JUSTIFY(TOT,5)
- if $DATA(RAFL)
- WRITE ?68,$JUSTIFY(WWU,5)
- +3 IF $GET(RACMLIST)
- IF '$DATA(RASUM)
- WRITE !!?2,RATITLE," Total",?50,$JUSTIFY(IN,5),?57,$JUSTIFY(OUT,5),?64,$JUSTIFY(TOT,5)
- +4 IF $GET(RACMLIST)
- IF $DATA(RASUM)
- WRITE !!?2,"Imaging Type"," Total",?40,$JUSTIFY(IN,5),?47,$JUSTIFY(OUT,5),?54,$JUSTIFY(TOT,5)
- if $DATA(RAFL)
- WRITE ?68,$JUSTIFY(WWU,5)
- +5 IF ($Y+4)>IOSL
- DO EOS
- if $DATA(RAEOS)
- QUIT
- if '$DATA(RASUM)
- QUIT
- DO HD
- if $DATA(RAEOS)
- QUIT
- +6 IF $DATA(RASUM)
- IF 'RAPCE
- Begin DoDot:1
- +7 IF TOT>0
- Begin DoDot:2
- +8 WRITE !!!?2,"NOTE: Since a procedure can be performed by more than one technologist,",!?8,"the total number of exams and weighted work units by division and",!?8,"imaging type is likely to be higher than the other workload r
- eports."
- +9 QUIT
- End DoDot:2
- QUIT
- End DoDot:1
- +10 IF $DATA(RASUM)&(RAPCE=12!(RAPCE=15))
- Begin DoDot:1
- +11 IF TOT>0
- Begin DoDot:2
- +12 if RAPRIM=0
- WRITE !!!?2,"NOTE: Since a procedure can be performed by more than one Interpreting ",!?8,$SELECT(RAPCE=12:"Resident",1:"Staff"),", the total number of exams by division and imaging type"
- +13 if RAPRIM=0
- WRITE !?8,"is likely to be higher than the other workload reports."
- +14 if RAPRIM=0
- WRITE !?8,"Both Primary and Secondary Interpreting "_$PIECE(RATITLE," ",2)_" are included in",!?8,"this report."
- +15 if RAPRIM=1
- WRITE !!?2,"NOTE: Only Primary Interpreting "_$SELECT($PIECE(RATITLE," ",2)="Resident":"Residents",1:"Staff")_" are included in this report."
- +16 QUIT
- End DoDot:2
- QUIT
- +17 QUIT
- End DoDot:1
- +18 IF ($Y+4)>IOSL
- DO EOS
- if $DATA(RAEOS)
- QUIT
- DO HD
- if $DATA(RAEOS)
- QUIT
- +19 IF $DATA(RASUM)
- IF ($PIECE(RATITLE," ")'="Interpreting")
- WRITE !!?3,"# of "_RATITLE_"s selected: "_$SELECT(RAINPUT=1:"ALL",1:$GET(RAFLDCNT))
- +20 IF $DATA(RASUM)
- IF ($PIECE(RATITLE," ")="Interpreting")
- Begin DoDot:1
- +21 WRITE !!?3,"# of "_$SELECT($GET(RAPRIM)=1:"Primary ",1:"")_$SELECT($PIECE(RATITLE," ",2)="Resident":"Residents",1:"Staff")_" selected: "_$SELECT(RAINPUT=1:"ALL",1:$GET(RAFLDCNT))
- +22 QUIT
- End DoDot:1
- +23 IF $DATA(RASUM)
- IF $ORDER(^TMP($JOB,"RA",RADIV))=""
- IF RAITCNT(RADIV)=1
- QUIT
- +24 DO EOS
- +25 QUIT
- PRT1 ;
- +1 IF ($Y+4)>IOSL
- DO EOS
- if $DATA(RAEOS)
- QUIT
- DO HD
- if $DATA(RAEOS)
- QUIT
- +2 if '$GET(RACMLIST)
- WRITE !,@ZZZ,?40,$JUSTIFY(RAIN,5),?47,$JUSTIFY(RAOUT,5),?54,$JUSTIFY(RATOT,5),?61,$JUSTIFY($SELECT(TOT:(100*RATOT)/TOT,1:0),5,1)
- if $DATA(RAFL)
- WRITE ?68,$JUSTIFY(RAWWU,5),?75,$JUSTIFY($SELECT(WWU:(RAWWU*100)/WWU,1:0),5,1)
- +3 IF $GET(RACMLIST)
- IF '$DATA(RASUM)
- WRITE !,@ZZZ,?50,$JUSTIFY(RAIN,5),?57,$JUSTIFY(RAOUT,5),?64,$JUSTIFY(RATOT,5),?71,$JUSTIFY($SELECT(TOT:(100*RATOT)/TOT,1:0),5,1)
- +4 IF $GET(RACMLIST)
- IF $DATA(RASUM)
- WRITE !,@ZZZ,?40,$JUSTIFY(RAIN,5),?47,$JUSTIFY(RAOUT,5),?54,$JUSTIFY(RATOT,5),?61,$JUSTIFY($SELECT(TOT:(100*RATOT)/TOT,1:0),5,1)
- +5 QUIT
- HD ; header
- +1 if $Y>0
- WRITE @IOF
- WRITE !?10,">>> ",RATITLE," Workload Report <<<"
- SET PAGE=PAGE+1
- WRITE ?70,"Page: ",PAGE
- +2 WRITE !!?4,"Division: ",$SELECT($DATA(^DIC(4,+RADIV,0)):$PIECE(^(0),U,1),1:"UNKNOWN"),!,"Imaging Type: ",$SELECT($DATA(^RA(79.2,+$PIECE(RAITYPE,"-",2),0)):$PIECE(^(0),U,1),1:"UNKNOWN"),?52,"For period: ",?64,BEGDATE,?76,"to"
- +3 WRITE !?4,"Run Date: ",RARUNDTE,?64,ENDDATE
- +4 if '$GET(RACMLIST)
- WRITE !!?45,"Examinations",?61,"Percent"
- if $DATA(RAFL)
- WRITE ?73,"Percent"
- +5 IF $GET(RACMLIST)
- IF '$DATA(RASUM)
- WRITE !!?55,"Examinations",?71,"Percent"
- +6 IF $GET(RACMLIST)
- IF $DATA(RASUM)
- WRITE !!?45,"Examinations",?61,"Percent"
- +7 if '$GET(RACMLIST)
- WRITE !?2,$SELECT('$DATA(RASUM):"Procedure (CPT)",1:RATITLE),?40," In",?47," Out",?54,"Total",?61," Exams"
- if $DATA(RAFL)
- WRITE ?67," WWU",?73," WWU"
- +8 IF $GET(RACMLIST)
- IF '$DATA(RASUM)
- WRITE !?2,"Procedure (CPT) (* : > 3 CPT mods)",?50," In",?57," Out",?64,"Total",?71," Exams"
- +9 IF $GET(RACMLIST)
- IF $DATA(RASUM)
- WRITE !?2,RATITLE,?40," In",?47," Out",?54,"Total",?61," Exams"
- +10 WRITE !,RA80DASH
- +11 if '$DATA(RASUM)
- WRITE !?10,RATITLE,": ",RAFLD
- +12 if $DATA(RASUM)
- WRITE !,?10,"(Imaging Type Summary)"
- +13 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- if $GET(ZTSTOP)=1
- SET RAEOS=1
- +14 QUIT
- EOS ; end of screen
- +1 SET X=$$EOS^RAUTL5()
- +2 if X=1
- SET RAEOS=""
- +3 QUIT