RAESR2 ;HISC/GJC-Exam Statistics Rpt ;1/20/95 09:53
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PURGE ; Kill variables, close device and exit
K %,%DT,%W,%Y1,A,B,BEGDATE,BEGDTX,ENDDATE,ENDDTX,I,RABEG,RACMP,RACNB
K RACNI,RACTE,RAD0,RADAT,RADFN,RADNB,RADNM,RADTE,RADTI,RADU,RAEND,RAFLG
K RAINM,RALINE,RALNM,RAP0,RAPGE,RAPOP,RAQUIT,RARD,RARPT,RARUNDT,RASTAT
K RATMEFRM,RATMP,RATOT,RAXIT,RAZ,T,T1,X,X1,Y,Z,ZTDESC,ZTRTN,ZTSAVE
K ^TMP($J,"RASTAT"),^TMP($J,"RA D-TYPE"),^TMP($J,"RA I-TYPE")
K:$D(RAPSTX) RACCESS,RAPSTX
D CLOSE^RAUTL
K POP,RAMES
Q
DIVCHK ; Output stats by division
; Print out totals for division 'RADNM'. Move on to next set of
; division, imaging type, and location data.
Q:RAXIT N RA1,RA2,RA3,RASWTCH S RASWTCH=0
S RATOT=$G(^TMP($J,"RASTAT","RADIV",RADNM))
I $Y>(IOSL-4) D Q:RAXIT
. N RAINM,RALNM S (RAINM,RALNM)=""
. S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
. Q
I 'RASWTCH D
. W !!!?5,"Division: ",RADNM,!
. Q
D TOT1^RAESR3
; Now get the next division name. If null quit, if not get I-Type
; and Location data to print generic header.
I RARPT=1 S RA1=$O(^TMP($J,"RASTAT","RALOC",RADNM))
I RARPT=2 S RA1=$O(^TMP($J,"RASTAT","RAIMG",RADNM))
I RARPT=3 S RA1=$O(^TMP($J,"RASTAT","RADIV",RADNM))
I RA1]"" D
. N RADNM,RAINM,RALNM S RADNM=RA1
. S:RARPT=1 RA2=$O(^TMP($J,"RASTAT","RALOC",RADNM,""))
. S:RARPT=2 RA2=$O(^TMP($J,"RASTAT","RAIMG",RADNM,""))
. I RA2]"" D
.. S RAINM=RA2
.. I RARPT=1 D
... S RA3=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,"")),RALNM=$G(RA3)
... Q
.. Q
. S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
. Q
Q
IMGCHK ; Output stats by imaging type.
; Print out totals for I-Type 'RAINM'. Move on to next set of
; imaging type and location data.
Q:RAXIT N RASWTCH S RASWTCH=0
S RATOT=$G(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM))
I $Y>(IOSL-4) D Q:RAXIT
. N RALNM S RALNM="",RASWTCH=1
. S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
. Q
I 'RASWTCH D
. W !!!?5,"Imaging Type: ",RAINM,!
. Q
D TOT1^RAESR3
; Now get the next I-Type name. If null quit, if not get Location
; data to print generic header.
N RA1,RA2
S:RARPT=1 RA1=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM))
S:RARPT=2 RA1=$O(^TMP($J,"RASTAT","RAIMG",RADNM,RAINM))
I RA1]"" D
. N RAINM S RAINM=RA1
. I RARPT=1 D
.. S RA2=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,"")) S RALNM=RA2
.. Q
. S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
. Q
Q
LOCCHK ; Output stats by location.
; Print out totals for location 'RALNM'. Move on to next set of
; location data.
Q:RAXIT N RASWTCH S RASWTCH=0
S RATOT=$G(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM))
I $Y>(IOSL-4) D Q:RAXIT
. S RASWTCH=1,RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
. Q
I 'RASWTCH D
. W !?13,"------",?20,"------",?29,"------",?35
. F T=1:1 Q:T>RACNB W ?($X+1),"------"
. Q
D TOT1^RAESR3
; Now get the next location name. If null quit, if not print generic
; header.
N RA1 S RA1=$O(^TMP($J,"RASTAT","RALOC",RADNM,RAINM,RALNM))
I RA1]"" N RALNM S RALNM=RA1 D
. S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
. Q
Q
DIVSYN ; Division synopsis
S RAXIT=$$EOS^RAUTL5() Q:RAXIT
S (RADNM,RAINM,RALNM)="" D HD^RAESR3
N A,B,C S A="",C=0
F S A=$O(^TMP($J,"RASTAT","RAIMG",A)) Q:A']"" D Q:RAXIT
. W !!,"Division: ",A,!?3,"Imaging Type(s): " S B="",C=C+1
. F S B=$O(^TMP($J,"RASTAT","RAIMG",A,B)) Q:B']"" D Q:RAXIT
.. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
.. W:$X>(IOM-25) !?($X+$L("Imaging Type(s): ")+3) W B,?($X+3)
.. Q
. W ! S RATOT=$G(^TMP($J,"RASTAT","RADIV",A)) D TOT1^RAESR3
. Q
I C>1 D
. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HD^RAESR3
. W !!?3,"Total Over All Divisions:",!
. S RATOT=$G(^TMP($J,"RASTAT","RATOT")) D TOT1^RAESR3
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAESR2 3817 printed Dec 13, 2024@02:35:05 Page 2
RAESR2 ;HISC/GJC-Exam Statistics Rpt ;1/20/95 09:53
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
PURGE ; Kill variables, close device and exit
+1 KILL %,%DT,%W,%Y1,A,B,BEGDATE,BEGDTX,ENDDATE,ENDDTX,I,RABEG,RACMP,RACNB
+2 KILL RACNI,RACTE,RAD0,RADAT,RADFN,RADNB,RADNM,RADTE,RADTI,RADU,RAEND,RAFLG
+3 KILL RAINM,RALINE,RALNM,RAP0,RAPGE,RAPOP,RAQUIT,RARD,RARPT,RARUNDT,RASTAT
+4 KILL RATMEFRM,RATMP,RATOT,RAXIT,RAZ,T,T1,X,X1,Y,Z,ZTDESC,ZTRTN,ZTSAVE
+5 KILL ^TMP($JOB,"RASTAT"),^TMP($JOB,"RA D-TYPE"),^TMP($JOB,"RA I-TYPE")
+6 if $DATA(RAPSTX)
KILL RACCESS,RAPSTX
+7 DO CLOSE^RAUTL
+8 KILL POP,RAMES
+9 QUIT
DIVCHK ; Output stats by division
+1 ; Print out totals for division 'RADNM'. Move on to next set of
+2 ; division, imaging type, and location data.
+3 if RAXIT
QUIT
NEW RA1,RA2,RA3,RASWTCH
SET RASWTCH=0
+4 SET RATOT=$GET(^TMP($JOB,"RASTAT","RADIV",RADNM))
+5 IF $Y>(IOSL-4)
Begin DoDot:1
+6 NEW RAINM,RALNM
SET (RAINM,RALNM)=""
+7 SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+8 QUIT
End DoDot:1
if RAXIT
QUIT
+9 IF 'RASWTCH
Begin DoDot:1
+10 WRITE !!!?5,"Division: ",RADNM,!
+11 QUIT
End DoDot:1
+12 DO TOT1^RAESR3
+13 ; Now get the next division name. If null quit, if not get I-Type
+14 ; and Location data to print generic header.
+15 IF RARPT=1
SET RA1=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM))
+16 IF RARPT=2
SET RA1=$ORDER(^TMP($JOB,"RASTAT","RAIMG",RADNM))
+17 IF RARPT=3
SET RA1=$ORDER(^TMP($JOB,"RASTAT","RADIV",RADNM))
+18 IF RA1]""
Begin DoDot:1
+19 NEW RADNM,RAINM,RALNM
SET RADNM=RA1
+20 if RARPT=1
SET RA2=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,""))
+21 if RARPT=2
SET RA2=$ORDER(^TMP($JOB,"RASTAT","RAIMG",RADNM,""))
+22 IF RA2]""
Begin DoDot:2
+23 SET RAINM=RA2
+24 IF RARPT=1
Begin DoDot:3
+25 SET RA3=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,""))
SET RALNM=$GET(RA3)
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+29 QUIT
End DoDot:1
+30 QUIT
IMGCHK ; Output stats by imaging type.
+1 ; Print out totals for I-Type 'RAINM'. Move on to next set of
+2 ; imaging type and location data.
+3 if RAXIT
QUIT
NEW RASWTCH
SET RASWTCH=0
+4 SET RATOT=$GET(^TMP($JOB,"RASTAT","RAIMG",RADNM,RAINM))
+5 IF $Y>(IOSL-4)
Begin DoDot:1
+6 NEW RALNM
SET RALNM=""
SET RASWTCH=1
+7 SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+8 QUIT
End DoDot:1
if RAXIT
QUIT
+9 IF 'RASWTCH
Begin DoDot:1
+10 WRITE !!!?5,"Imaging Type: ",RAINM,!
+11 QUIT
End DoDot:1
+12 DO TOT1^RAESR3
+13 ; Now get the next I-Type name. If null quit, if not get Location
+14 ; data to print generic header.
+15 NEW RA1,RA2
+16 if RARPT=1
SET RA1=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM))
+17 if RARPT=2
SET RA1=$ORDER(^TMP($JOB,"RASTAT","RAIMG",RADNM,RAINM))
+18 IF RA1]""
Begin DoDot:1
+19 NEW RAINM
SET RAINM=RA1
+20 IF RARPT=1
Begin DoDot:2
+21 SET RA2=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,""))
SET RALNM=RA2
+22 QUIT
End DoDot:2
+23 SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+24 QUIT
End DoDot:1
+25 QUIT
LOCCHK ; Output stats by location.
+1 ; Print out totals for location 'RALNM'. Move on to next set of
+2 ; location data.
+3 if RAXIT
QUIT
NEW RASWTCH
SET RASWTCH=0
+4 SET RATOT=$GET(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,RALNM))
+5 IF $Y>(IOSL-4)
Begin DoDot:1
+6 SET RASWTCH=1
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+7 QUIT
End DoDot:1
if RAXIT
QUIT
+8 IF 'RASWTCH
Begin DoDot:1
+9 WRITE !?13,"------",?20,"------",?29,"------",?35
+10 FOR T=1:1
if T>RACNB
QUIT
WRITE ?($X+1),"------"
+11 QUIT
End DoDot:1
+12 DO TOT1^RAESR3
+13 ; Now get the next location name. If null quit, if not print generic
+14 ; header.
+15 NEW RA1
SET RA1=$ORDER(^TMP($JOB,"RASTAT","RALOC",RADNM,RAINM,RALNM))
+16 IF RA1]""
NEW RALNM
SET RALNM=RA1
Begin DoDot:1
+17 SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+18 QUIT
End DoDot:1
+19 QUIT
DIVSYN ; Division synopsis
+1 SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
+2 SET (RADNM,RAINM,RALNM)=""
DO HD^RAESR3
+3 NEW A,B,C
SET A=""
SET C=0
+4 FOR
SET A=$ORDER(^TMP($JOB,"RASTAT","RAIMG",A))
if A']""
QUIT
Begin DoDot:1
+5 WRITE !!,"Division: ",A,!?3,"Imaging Type(s): "
SET B=""
SET C=C+1
+6 FOR
SET B=$ORDER(^TMP($JOB,"RASTAT","RAIMG",A,B))
if B']""
QUIT
Begin DoDot:2
+7 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+8 if $X>(IOM-25)
WRITE !?($X+$LENGTH("Imaging Type(s): ")+3)
WRITE B,?($X+3)
+9 QUIT
End DoDot:2
if RAXIT
QUIT
+10 WRITE !
SET RATOT=$GET(^TMP($JOB,"RASTAT","RADIV",A))
DO TOT1^RAESR3
+11 QUIT
End DoDot:1
if RAXIT
QUIT
+12 IF C>1
Begin DoDot:1
+13 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HD^RAESR3
+14 WRITE !!?3,"Total Over All Divisions:",!
+15 SET RATOT=$GET(^TMP($JOB,"RASTAT","RATOT"))
DO TOT1^RAESR3
+16 QUIT
End DoDot:1
+17 QUIT
