- 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 Feb 19, 2025@00:01:22 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