- 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
- 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
