RAESR1 ;HISC/GJC-Exam Statistics Rpt ;1/20/95 09:36
;;5.0;Radiology/Nuclear Medicine;**48**;Mar 16, 1998
S (RAPGE,RATOT,RAXIT)=0,RARUNDT=$$FMTE^XLFDT($$DT^XLFDT(),1)
S $P(RALINE,"-",78)=""
I '$D(^TMP($J,"RASTAT","RALOC")) D G PURGE^RAESR2
. W @IOF,!!?5,"No exams registered for time period "
. W BEGDTX_" to "_ENDDTX_".",!
. Q
D @RARPT
I 'RAXIT D
. D DIVSYN^RAESR2
. Q
D PURGE^RAESR2
Q
1 ; Print Location Statistics
S RADNM=$O(^TMP($J,"RASTAT","RALOC",""))
S RAINM=$O(^TMP($J,"RASTAT","RALOC",RADNM,""))
S RALNM=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,""))
S T1=1 D HD^RAESR3 S RADNM=""
F S RADNM=$O(^TMP($J,"RASTAT","RALOC",RADNM)) Q:RADNM="" D Q:RAXIT
. S RAINM=""
. F S RAINM=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM)) Q:RAINM="" D Q:RAXIT
.. S RALNM=""
.. F S RALNM=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM)) Q:RALNM="" D Q:RAXIT
... S RADAT=0
... F S RADAT=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT)) Q:'RADAT D Q:RAXIT
.... S RASTAT=$G(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT))
.... S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
.... Q
... D LOCCHK^RAESR2 Q:RAXIT
... Q
.. D IMGCHK^RAESR2 Q:RAXIT
.. Q
. D DIVCHK^RAESR2 Q:RAXIT
. Q
Q
2 ; Print Imaging Type Statistics
S RADNM=$O(^TMP($J,"RASTAT","RAIMG",""))
S RAINM=$O(^TMP($J,"RASTAT","RAIMG",RADNM,""))
S T1=2 D HD^RAESR3 S RADNM=""
F S RADNM=$O(^TMP($J,"RASTAT","RAIMG",RADNM)) Q:RADNM="" D Q:RAXIT
. S RAINM="" F S RAINM=$O(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM)) Q:RAINM="" D Q:RAXIT
.. S RADAT=0 F S RADAT=$O(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT)) Q:'RADAT D Q:RAXIT
... S RASTAT=$G(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM,RADAT))
... S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
... Q
.. D IMGCHK^RAESR2 Q:RAXIT
.. Q
. D DIVCHK^RAESR2 Q:RAXIT
. Q
Q
3 ; Print Division Statistics
S RADNM=$O(^TMP($J,"RASTAT","RADIV","")),T1=3 D HD^RAESR3 S RADNM=""
F S RADNM=$O(^TMP($J,"RASTAT","RADIV",RADNM)) Q:RADNM="" D Q:RAXIT
. S RADAT=0
. F S RADAT=$O(^TMP($J,"RASTAT","RADIV",RADNM,RADAT)) Q:'RADAT D Q:RAXIT
.. S RASTAT=$G(^TMP($J,"RASTAT","RADIV",RADNM,RADAT))
.. S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
.. Q
. I 'RAXIT D TOT^RAESR3 D
.. N RA1 S RA1=$O(^TMP($J,"RASTAT","RADIV",RADNM))
.. I RA1]"" N RADNM S RADNM=RA1,RAXIT=$$EOS^RAUTL5() D:'RAXIT HD^RAESR3
.. Q
. Q
Q
4 ; Print all Statistics
S RADAT=0,T1=4 D HD^RAESR3
F S RADAT=$O(^TMP($J,"RASTAT","RATOT",RADAT)) Q:'RADAT D Q:RAXIT
. S RASTAT=$G(^TMP($J,"RASTAT","RATOT",RADAT))
. S RADAT("X")=$$FMTE^XLFDT(RADAT,1) D PRT^RAESR3
. Q
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
D TOT^RAESR3 ;Print total line
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAESR1 2749 printed Oct 16, 2024@18:35:40 Page 2
RAESR1 ;HISC/GJC-Exam Statistics Rpt ;1/20/95 09:36
+1 ;;5.0;Radiology/Nuclear Medicine;**48**;Mar 16, 1998
+2 SET (RAPGE,RATOT,RAXIT)=0
SET RARUNDT=$$FMTE^XLFDT($$DT^XLFDT(),1)
+3 SET $PIECE(RALINE,"-",78)=""
+4 IF '$DATA(^TMP($JOB,"RASTAT","RALOC"))
Begin DoDot:1
+5 WRITE @IOF,!!?5,"No exams registered for time period "
+6 WRITE BEGDTX_" to "_ENDDTX_".",!
+7 QUIT
End DoDot:1
GOTO PURGE^RAESR2
+8 DO @RARPT
+9 IF 'RAXIT
Begin DoDot:1
+10 DO DIVSYN^RAESR2
+11 QUIT
End DoDot:1
+12 DO PURGE^RAESR2
+13 QUIT
1 ; Print Location Statistics
+1 SET RADNM=$ORDER(^TMP($JOB,"RASTAT","RALOC",""))
+2 SET RAINM=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,""))
+3 SET RALNM=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,""))
+4 SET T1=1
DO HD^RAESR3
SET RADNM=""
+5 FOR
SET RADNM=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM))
if RADNM=""
QUIT
Begin DoDot:1
+6 SET RAINM=""
+7 FOR
SET RAINM=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM))
if RAINM=""
QUIT
Begin DoDot:2
+8 SET RALNM=""
+9 FOR
SET RALNM=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,RALNM))
if RALNM=""
QUIT
Begin DoDot:3
+10 SET RADAT=0
+11 FOR
SET RADAT=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT))
if 'RADAT
QUIT
Begin DoDot:4
+12 SET RASTAT=$GET(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,RALNM,RADAT))
+13 SET RADAT("X")=$$FMTE^XLFDT(RADAT,1)
DO PRT^RAESR3
+14 QUIT
End DoDot:4
if RAXIT
QUIT
+15 DO LOCCHK^RAESR2
if RAXIT
QUIT
+16 QUIT
End DoDot:3
if RAXIT
QUIT
+17 DO IMGCHK^RAESR2
if RAXIT
QUIT
+18 QUIT
End DoDot:2
if RAXIT
QUIT
+19 DO DIVCHK^RAESR2
if RAXIT
QUIT
+20 QUIT
End DoDot:1
if RAXIT
QUIT
+21 QUIT
2 ; Print Imaging Type Statistics
+1 SET RADNM=$ORDER(^TMP($JOB,"RASTAT","RAIMG",""))
+2 SET RAINM=$ORDER(^TMP($JOB,"RASTAT","RAIMG",RADNM,""))
+3 SET T1=2
DO HD^RAESR3
SET RADNM=""
+4 FOR
SET RADNM=$ORDER(^TMP($JOB,"RASTAT","RAIMG",RADNM))
if RADNM=""
QUIT
Begin DoDot:1
+5 SET RAINM=""
FOR
SET RAINM=$ORDER(^TMP($JOB,"RASTAT","RAIMG",RADNM,RAINM))
if RAINM=""
QUIT
Begin DoDot:2
+6 SET RADAT=0
FOR
SET RADAT=$ORDER(^TMP($JOB,"RASTAT","RAIMG",RADNM,RAINM,RADAT))
if 'RADAT
QUIT
Begin DoDot:3
+7 SET RASTAT=$GET(^TMP($JOB,"RASTAT","RAIMG",RADNM,RAINM,RADAT))
+8 SET RADAT("X")=$$FMTE^XLFDT(RADAT,1)
DO PRT^RAESR3
+9 QUIT
End DoDot:3
if RAXIT
QUIT
+10 DO IMGCHK^RAESR2
if RAXIT
QUIT
+11 QUIT
End DoDot:2
if RAXIT
QUIT
+12 DO DIVCHK^RAESR2
if RAXIT
QUIT
+13 QUIT
End DoDot:1
if RAXIT
QUIT
+14 QUIT
3 ; Print Division Statistics
+1 SET RADNM=$ORDER(^TMP($JOB,"RASTAT","RADIV",""))
SET T1=3
DO HD^RAESR3
SET RADNM=""
+2 FOR
SET RADNM=$ORDER(^TMP($JOB,"RASTAT","RADIV",RADNM))
if RADNM=""
QUIT
Begin DoDot:1
+3 SET RADAT=0
+4 FOR
SET RADAT=$ORDER(^TMP($JOB,"RASTAT","RADIV",RADNM,RADAT))
if 'RADAT
QUIT
Begin DoDot:2
+5 SET RASTAT=$GET(^TMP($JOB,"RASTAT","RADIV",RADNM,RADAT))
+6 SET RADAT("X")=$$FMTE^XLFDT(RADAT,1)
DO PRT^RAESR3
+7 QUIT
End DoDot:2
if RAXIT
QUIT
+8 IF 'RAXIT
DO TOT^RAESR3
Begin DoDot:2
+9 NEW RA1
SET RA1=$ORDER(^TMP($JOB,"RASTAT","RADIV",RADNM))
+10 IF RA1]""
NEW RADNM
SET RADNM=RA1
SET RAXIT=$$EOS^RAUTL5()
if 'RAXIT
DO HD^RAESR3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
if RAXIT
QUIT
+13 QUIT
4 ; Print all Statistics
+1 SET RADAT=0
SET T1=4
DO HD^RAESR3
+2 FOR
SET RADAT=$ORDER(^TMP($JOB,"RASTAT","RATOT",RADAT))
if 'RADAT
QUIT
Begin DoDot:1
+3 SET RASTAT=$GET(^TMP($JOB,"RASTAT","RATOT",RADAT))
+4 SET RADAT("X")=$$FMTE^XLFDT(RADAT,1)
DO PRT^RAESR3
+5 QUIT
End DoDot:1
if RAXIT
QUIT
+6 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+7 ;Print total line
DO TOT^RAESR3
+8 QUIT
