RAESR3 ;HISC/GJC-Exam Statistics Rpt ;1/20/95 08:31
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PRT ; Update total and Print out date, # of visits, # of exams,
; # of completed exams, and category statistics.
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD
F I=1:1:(RACNB+3) S $P(RATOT,"^",I)=$P(RATOT,"^",I)+$P(RASTAT,"^",I)
W !,RADAT("X"),?13,$J(+$P(RASTAT,"^"),6),?20,$J(+$P(RASTAT,"^",2),6),?29,$J(+$P(RASTAT,"^",3),6),?35 F I=4:1:(RACNB+3) W ?($X+1),$J(+$P(RASTAT,"^",I),6)
Q
TOT ; Print total line
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD
W !,?13,"------",?20,"------",?29,"------",?35
F T=1:1 Q:T>RACNB W ?($X+1),"------"
S:T1=1 RATOT=$G(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM))
S:T1=2 RATOT=$G(^TMP($J,"RASTAT","RALOC",RADNM,RAINM))
S:T1=3 RATOT=$G(^TMP($J,"RASTAT","RADIV",RADNM))
S:T1=4 RATOT=$G(^TMP($J,"RASTAT","RATOT"))
TOT1 W !,"TOTAL",?13,$J(+$P(RATOT,"^"),6),?20,$J(+$P(RATOT,"^",2),6),?29,$J(+$P(RATOT,"^",3),6),?35 F I=4:1:(RACNB+3) W ?($X+1),$J(+$P(RATOT,"^",I),6)
Q
HD ; Print out header info for each new location and each new division
W:$E(IOST,1,2)="C-"!(RAPGE) @IOF
W !?20,">>>>> EXAMINATION STATISTICS <<<<<"
S RAPGE=RAPGE+1 W ?70,"Page: ",RAPGE
S RADNM=$G(RADNM),RAINM=$G(RAINM),RALNM=$G(RALNM)
I T1=1 D
. W !!,"Division: ",$E(RADNM,1,25),?40,"Location: ",$E(RALNM,1,25)
. W !,"Run Date: ",RARUNDT,?40,"Imaging Type: ",$E(RAINM,1,25)
I T1=2 D
. W !!,"Division: ",$E(RADNM,1,25),?40,"Location: "
. W !,"Run Date: ",RARUNDT,?40,"Imaging Type: ",$E(RAINM,1,25)
I T1=3 D
. W !!,"Division: ",$E(RADNM,1,25),?40,"Location: "
. W !,"Run Date: ",RARUNDT,?40,"Imaging Type: "
I T1=4 D
. W !!,"Division: ",?40,"Location: "
. W !,"Run Date: ",RARUNDT,?40,"Imaging Type: "
W !,$$CJ^XLFSTR(RATMEFRM,IOM)
W !!,?27,"COMPLETE",?36,"--------------EXAM CATEGORY--------------"
W !,"DATE",?13,"VISITS",?21,"EXAMS",?30,"EXAMS",?35 F T=1:1 Q:T>RACNB W ?($X+4),$E($P(RADU,";",T),3,5)
W !,RALINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAESR3 1999 printed Oct 16, 2024@18:35:42 Page 2
RAESR3 ;HISC/GJC-Exam Statistics Rpt ;1/20/95 08:31
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PRT ; Update total and Print out date, # of visits, # of exams,
+1 ; # of completed exams, and category statistics.
+2 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD
+3 FOR I=1:1:(RACNB+3)
SET $PIECE(RATOT,"^",I)=$PIECE(RATOT,"^",I)+$PIECE(RASTAT,"^",I)
+4 WRITE !,RADAT("X"),?13,$JUSTIFY(+$PIECE(RASTAT,"^"),6),?20,$JUSTIFY(+$PIECE(RASTAT,"^",2),6),?29,$JUSTIFY(+$PIECE(RASTAT,"^",3),6),?35
FOR I=4:1:(RACNB+3)
WRITE ?($X+1),$JUSTIFY(+$PIECE(RASTAT,"^",I),6)
+5 QUIT
TOT ; Print total line
+1 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD
+2 WRITE !,?13,"------",?20,"------",?29,"------",?35
+3 FOR T=1:1
if T>RACNB
QUIT
WRITE ?($X+1),"------"
+4 if T1=1
SET RATOT=$GET(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,RALNM))
+5 if T1=2
SET RATOT=$GET(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM))
+6 if T1=3
SET RATOT=$GET(^TMP($JOB,"RASTAT","RADIV",RADNM))
+7 if T1=4
SET RATOT=$GET(^TMP($JOB,"RASTAT","RATOT"))
TOT1 WRITE !,"TOTAL",?13,$JUSTIFY(+$PIECE(RATOT,"^"),6),?20,$JUSTIFY(+$PIECE(RATOT,"^",2),6),?29,$JUSTIFY(+$PIECE(RATOT,"^",3),6),?35
FOR I=4:1:(RACNB+3)
WRITE ?($X+1),$JUSTIFY(+$PIECE(RATOT,"^",I),6)
+1 QUIT
HD ; Print out header info for each new location and each new division
+1 if $EXTRACT(IOST,1,2)="C-"!(RAPGE)
WRITE @IOF
+2 WRITE !?20,">>>>> EXAMINATION STATISTICS <<<<<"
+3 SET RAPGE=RAPGE+1
WRITE ?70,"Page: ",RAPGE
+4 SET RADNM=$GET(RADNM)
SET RAINM=$GET(RAINM)
SET RALNM=$GET(RALNM)
+5 IF T1=1
Begin DoDot:1
+6 WRITE !!,"Division: ",$EXTRACT(RADNM,1,25),?40,"Location: ",$EXTRACT(RALNM,1,25)
+7 WRITE !,"Run Date: ",RARUNDT,?40,"Imaging Type: ",$EXTRACT(RAINM,1,25)
End DoDot:1
+8 IF T1=2
Begin DoDot:1
+9 WRITE !!,"Division: ",$EXTRACT(RADNM,1,25),?40,"Location: "
+10 WRITE !,"Run Date: ",RARUNDT,?40,"Imaging Type: ",$EXTRACT(RAINM,1,25)
End DoDot:1
+11 IF T1=3
Begin DoDot:1
+12 WRITE !!,"Division: ",$EXTRACT(RADNM,1,25),?40,"Location: "
+13 WRITE !,"Run Date: ",RARUNDT,?40,"Imaging Type: "
End DoDot:1
+14 IF T1=4
Begin DoDot:1
+15 WRITE !!,"Division: ",?40,"Location: "
+16 WRITE !,"Run Date: ",RARUNDT,?40,"Imaging Type: "
End DoDot:1
+17 WRITE !,$$CJ^XLFSTR(RATMEFRM,IOM)
+18 WRITE !!,?27,"COMPLETE",?36,"--------------EXAM CATEGORY--------------"
+19 WRITE !,"DATE",?13,"VISITS",?21,"EXAMS",?30,"EXAMS",?35
FOR T=1:1
if T>RACNB
QUIT
WRITE ?($X+4),$EXTRACT($PIECE(RADU,";",T),3,5)
+20 WRITE !,RALINE
+21 QUIT
