RAESR2.m

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

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