- RASTRPT1 ;HISC/SS-Status Tracking Statistics Report ;4/28/00 10:00
- ;;5.0;Radiology/Nuclear Medicine;**20**;Mar 16, 1998
- ;Last Modifications by SS on MAY 15,2000 for patch P20
- RPTP20 ;P20, create report by requesting locations from ^TMP with proc details
- N RARL ;requesting location
- N RADV1 S RADV1=RADV,RARL=0
- N RAZZSSFL S RAZZSSFL="DETAILS"
- F S RARL=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL)) Q:RARL=""!RAXIT D
- .S RAFR=0 F S RAFR=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR)) Q:RAFR'>0!RAXIT D
- ..S RATO=0
- ..F S RATO=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO)) Q:RATO'>0!RAXIT D HDR3,PROC
- ..Q
- .Q
- D RPTP20S
- I +RA20RLOC>1 D PUTNOST(RAIMAGE,RADV1,$J)
- Q
- RPTP20S ;P20, create report by requesting locations from ^TMP proc summary
- N RARL ;requesting location
- N RADV1 S RADV1=RADV,RARL=0
- N I1,I2
- N RAZZSSFL S RAZZSSFL="SUMMARY"
- F S RARL=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL)) Q:RARL=""!RAXIT D HDR3 Q:RAXIT D
- .S RAFR=0 F S RAFR=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR)) Q:RAFR'>0!RAXIT D
- ..S RATO=0
- ..F S RATO=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO)) Q:RATO'>0!RAXIT S RASUM=^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO) D SUM1
- ..Q
- BP2 .D:'RAXIT SUM2
- .Q
- Q
- HDR3 ; Header for detailed report by requesting locations
- S RAPG=RAPG+1 W:$E(IOST,1,2)="C-" @IOF
- I $E(IOST,1,2)="P-",(RAPG>1) W @IOF
- W !,?20,"** Status Tracking Statistics Report **",?71,"Page: ",$J(RAPG,3)
- I RAZZSSFL="DETAILS" W !,?20,"Procedure Detail by Requesting Location"
- E W !,?19,"Division Summary Requesting Location Details"
- I +RA20RLOC=0 W !?14,"(Only requesting locations with data are included)"
- W !!,?2,"Run Date: ",$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3)
- W ?42,"For Period: ",$E(BEGDATE,4,5),"/",$E(BEGDATE,6,7),"/",$E(BEGDATE,2,3)," - ",$E(ENDDATE,4,5),"/",$E(ENDDATE,6,7),"/",$E(ENDDATE,2,3)
- W !?2,"Division: ",$E($P($G(RACCESS(DUZ,"DIV",RADV,+$O(RACCESS(DUZ,"DIV",RADV,0)))),U,2),1,25),?40,"Imaging Type: ",$E(RAIMAGE(0),1,25)
- Q:RAZZSSFL="NOSTAT"
- W !?2,"Requesting Location: ",$E(RARL,1,76)
- I RAZZSSFL="DETAILS" W !!,?10,"From: ",$S($D(^RA(72,+RAFR,0)):$P(^(0),"^"),1:"Unknown"),!,?10,"To : ",$S($D(^RA(72,+RATO,0)):$P(^(0),"^"),1:"Unknown")
- W !,?33,"Minimum",?45,"Maximum",?57,"Average",!,?34,"Time",?46,"Time",?58,"Time",?67,"Number of",!
- I RAZZSSFL="DETAILS" W ?4,"Procedure (CPT)"
- W ?31,"(DD:HH:MM)",?43,"(DD:HH:MM)",?55,"(DD:HH:MM)",?67,"Procedures"
- I RAZZSSFL="DETAILS" W !,?4,"---------------"
- W !?31,"----------",?43,"----------",?55,"----------",?67,"----------",!
- I RAZZSSFL="DETAILS" S RACTR=0
- I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
- Q
- ;
- PROC F RAPRC=0:0 S RAPRC=$O(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO,RAPRC)) Q:RAPRC'>0!RAXIT S RAPROC=^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO,RAPRC) D DET1
- Q:'$D(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO))!RAXIT
- S RASUM=$G(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO)) D DET2
- Q
- DET1 W !
- I RAZZSSFL="DETAILS" D CPT W RACPT
- W ?32,$P(RAPROC,"^",4),?44,$P(RAPROC,"^",2)
- S X=$P(RAPROC,"^",6)\$P(RAPROC,"^",5) D MINUTS^RAUTL1 W ?56,Y,?70,$J($P(RAPROC,"^",5),5) S RACTR=RACTR+1
- I $Y>(IOSL-4) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) I 'RAXIT D HDR3
- K RAPROC
- Q
- ;
- DET2 W !,?31,"----------",?43,"----------",?55,"----------",?67,"----------",!,?4,"Overall:" W ?32,$P(RASUM,"^",4),?44,$P(RASUM,"^",2)
- S X=$P(RASUM,"^",6)\$P(RASUM,"^",5) D MINUTS^RAUTL1 W ?56,Y,?70,$J($P(RASUM,"^",5),5)
- S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0)
- K RASUM
- Q
- ;
- CPT S RACPT=$G(^RAMIS(71,+RAPRC,0)) Q:RACPT=""
- S RAZZZ=$P($$NAMCODE^RACPTMSC(+$P(RACPT,"^",9),DT),"^")
- S RACPT=$E($P(RACPT,"^"),1,25)_"("_RAZZZ_")"
- K RAZZZ
- Q
- ;
- GETLOC() ;P20 by SS
- N RA20 S RA20="Requesting Location:"
- I +RA20RLOC=0 Q RA20_"ALL"
- I +RA20RLOC=1 Q RA20_$E($P(RA20RLOC,"^",2),1,16)
- Q RA20_"ALL SELECTED"
- GETPROC() ;P20 by SS
- N RA20 S RA20="Procedure:"
- I +RAPROCED=0 S RA20=RA20_"ALL"
- E S RA20=RA20_$E($P(RAPROCED,"^",2),1,25)
- Q RA20
- ;
- SUM1 W !,?4,"From: ",$S($D(^RA(72,RAFR,0)):$P(^(0),"^"),1:"Unknown"),!,?4,"To : ",$S($D(^RA(72,+RATO,0)):$P(^(0),"^"),1:"Unknown")
- W ?32,$P(RASUM,"^",4),?44,$P(RASUM,"^",2)
- S X=$P(RASUM,"^",6)\$P(RASUM,"^",5) D MINUTS^RAUTL1 W ?56,Y,?70,$J($P(RASUM,"^",5),5),! S RACTR=RACTR+3
- I $Y>(IOSL-4) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) I 'RAXIT D HDR3
- K RASUM
- Q
- SUM2 W !,?31,"----------",?43,"----------",?55,"----------",?67,"----------",!,?4,"From: ",$S($D(^RA(72,+RA(1),0)):$P(^(0),"^"),1:"Unknown"),!,?4,"To : ",$S($D(^RA(72,+RA,0)):$P(^(0),"^"),1:"Unknown")
- Q:'$D(^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"COMPLETE")) S RACOMP=^("COMPLETE") W ?32,$P(RACOMP,"^",4),?44,$P(RACOMP,"^",2)
- N RAZZSS1 S RAZZSS1=^TMP($J,"RAST",RAIMAGE,RADV1,RARL,"COUNT")
- S X=$P(RACOMP,"^",6)\$P(RACOMP,"^",5) D MINUTS^RAUTL1 W ?56,Y
- I $Y>(IOSL-2) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) I 'RAXIT D HDR3
- W !!?4,"Total number of exams moved to a status of COMPLETE"
- W !?4,"for period ",$E(BEGDATE,4,5),"/",$E(BEGDATE,6,7),"/",$E(BEGDATE,2,3)," - ",$E(ENDDATE,4,5),"/",$E(ENDDATE,6,7),"/",$E(ENDDATE,2,3),": ",?70,$J(RAZZSS1,5)
- Q:$O(^TMP($J,"RASTAT",RADV1))'>0
- S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0)
- Q
- ;
- PUTNOST(RAIM1,RADV1,RA20J) ;P20 by SS Display all locations which have not exams
- N RA20A,RA20B,RA20C,RA20PASS,RA20FL
- S RAZZSSFL="NOSTAT"
- S RA20PASS=0,RA20FL=0,RA20B="There are no statistics for following selected requesting locations:",$P(RA20C,"-",70)=""
- STRT I RA20PASS>0 D HDR3 W !?2,RA20B,!?2,RA20C
- S RA20A=0
- F S RA20A=$O(^TMP(RA20J,"RA REQ-LOC",RA20A)) G:RA20A="" LST I '$$ISTHERE(RAIM1,RADV1,RA20A) S RA20FL=1 Q:RA20PASS=0 W !?2,RA20A I $Y>(IOSL-4) S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0) Q:RAXIT D HDR3 W !?2,RA20B,!?2,RA20C
- LST I RA20PASS>0 S RAXIT=$S($E(IOST)="C":$$EOS^RAUTL5(),1:0)
- I RA20PASS=0,RA20FL=0 Q
- I RA20PASS=0 S RA20PASS=1 G STRT
- Q
- ISTHERE(RAIM,RADV,RALOC) ;Does this requesting location have exams is in ^TMP($J..)
- N RA20A,RA20B,RA20C
- S (RA20A,RA20B)=0
- F S RA20A=$O(^TMP($J,"RAST",RAIM,RADV,RA20A)) Q:RA20A="" I RA20A=RALOC S RA20B=1 Q
- Q RA20B
- RASTRPT1 ;HISC/SS-Status Tracking Statistics Report ;4/28/00 10:00
- +1 ;;5.0;Radiology/Nuclear Medicine;**20**;Mar 16, 1998
- +2 ;Last Modifications by SS on MAY 15,2000 for patch P20
- RPTP20 ;P20, create report by requesting locations from ^TMP with proc details
- +1 ;requesting location
- NEW RARL
- +2 NEW RADV1
- SET RADV1=RADV
- SET RARL=0
- +3 NEW RAZZSSFL
- SET RAZZSSFL="DETAILS"
- +4 FOR
- SET RARL=$ORDER(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL))
- IF RARL=""!RAXIT
- QUIT
- Begin DoDot:1
- +5 SET RAFR=0
- FOR
- SET RAFR=$ORDER(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR))
- IF RAFR'>0!RAXIT
- QUIT
- Begin DoDot:2
- +6 SET RATO=0
- +7 FOR
- SET RATO=$ORDER(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO))
- IF RATO'>0!RAXIT
- QUIT
- DO HDR3
- DO PROC
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 DO RPTP20S
- +11 IF +RA20RLOC>1
- DO PUTNOST(RAIMAGE,RADV1,$JOB)
- +12 QUIT
- RPTP20S ;P20, create report by requesting locations from ^TMP proc summary
- +1 ;requesting location
- NEW RARL
- +2 NEW RADV1
- SET RADV1=RADV
- SET RARL=0
- +3 NEW I1,I2
- +4 NEW RAZZSSFL
- SET RAZZSSFL="SUMMARY"
- +5 FOR
- SET RARL=$ORDER(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL))
- IF RARL=""!RAXIT
- QUIT
- DO HDR3
- IF RAXIT
- QUIT
- Begin DoDot:1
- +6 SET RAFR=0
- FOR
- SET RAFR=$ORDER(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR))
- IF RAFR'>0!RAXIT
- QUIT
- Begin DoDot:2
- +7 SET RATO=0
- +8 FOR
- SET RATO=$ORDER(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO))
- IF RATO'>0!RAXIT
- QUIT
- SET RASUM=^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO)
- DO SUM1
- +9 QUIT
- End DoDot:2
- BP2 IF 'RAXIT
- DO SUM2
- +1 QUIT
- End DoDot:1
- +2 QUIT
- HDR3 ; Header for detailed report by requesting locations
- +1 SET RAPG=RAPG+1
- IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +2 IF $EXTRACT(IOST,1,2)="P-"
- IF (RAPG>1)
- WRITE @IOF
- +3 WRITE !,?20,"** Status Tracking Statistics Report **",?71,"Page: ",$JUSTIFY(RAPG,3)
- +4 IF RAZZSSFL="DETAILS"
- WRITE !,?20,"Procedure Detail by Requesting Location"
- +5 IF '$TEST
- WRITE !,?19,"Division Summary Requesting Location Details"
- +6 IF +RA20RLOC=0
- WRITE !?14,"(Only requesting locations with data are included)"
- +7 WRITE !!,?2,"Run Date: ",$EXTRACT(DT,4,5),"/",$EXTRACT(DT,6,7),"/",$EXTRACT(DT,2,3)
- +8 WRITE ?42,"For Period: ",$EXTRACT(BEGDATE,4,5),"/",$EXTRACT(BEGDATE,6,7),"/",$EXTRACT(BEGDATE,2,3)," - ",$EXTRACT(ENDDATE,4,5),"/",$EXTRACT(ENDDATE,6,7),"/",$EXTRACT(ENDDATE,2,3)
- +9 WRITE !?2,"Division: ",$EXTRACT($PIECE($GET(RACCESS(DUZ,"DIV",RADV,+$ORDER(RACCESS(DUZ,"DIV",RADV,0)))),U,2),1,25),?40,"Imaging Type: ",$EXTRACT(RAIMAGE(0),1,25)
- +10 IF RAZZSSFL="NOSTAT"
- QUIT
- +11 WRITE !?2,"Requesting Location: ",$EXTRACT(RARL,1,76)
- +12 IF RAZZSSFL="DETAILS"
- WRITE !!,?10,"From: ",$SELECT($DATA(^RA(72,+RAFR,0)):$PIECE(^(0),"^"),1:"Unknown"),!,?10,"To : ",$SELECT($DATA(^RA(72,+RATO,0)):$PIECE(^(0),"^"),1:"Unknown")
- +13 WRITE !,?33,"Minimum",?45,"Maximum",?57,"Average",!,?34,"Time",?46,"Time",?58,"Time",?67,"Number of",!
- +14 IF RAZZSSFL="DETAILS"
- WRITE ?4,"Procedure (CPT)"
- +15 WRITE ?31,"(DD:HH:MM)",?43,"(DD:HH:MM)",?55,"(DD:HH:MM)",?67,"Procedures"
- +16 IF RAZZSSFL="DETAILS"
- WRITE !,?4,"---------------"
- +17 WRITE !?31,"----------",?43,"----------",?55,"----------",?67,"----------",!
- +18 IF RAZZSSFL="DETAILS"
- SET RACTR=0
- +19 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- IF $GET(ZTSTOP)=1
- SET RAXIT=1
- +20 QUIT
- +21 ;
- PROC FOR RAPRC=0:0
- SET RAPRC=$ORDER(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO,RAPRC))
- IF RAPRC'>0!RAXIT
- QUIT
- SET RAPROC=^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"PROC",RAFR,RATO,RAPRC)
- DO DET1
- +1 IF '$DATA(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO))!RAXIT
- QUIT
- +2 SET RASUM=$GET(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"SUM",RAFR,RATO))
- DO DET2
- +3 QUIT
- DET1 WRITE !
- +1 IF RAZZSSFL="DETAILS"
- DO CPT
- WRITE RACPT
- +2 WRITE ?32,$PIECE(RAPROC,"^",4),?44,$PIECE(RAPROC,"^",2)
- +3 SET X=$PIECE(RAPROC,"^",6)\$PIECE(RAPROC,"^",5)
- DO MINUTS^RAUTL1
- WRITE ?56,Y,?70,$JUSTIFY($PIECE(RAPROC,"^",5),5)
- SET RACTR=RACTR+1
- +4 IF $Y>(IOSL-4)
- SET RAXIT=$SELECT($EXTRACT(IOST)="C":$$EOS^RAUTL5(),1:0)
- IF 'RAXIT
- DO HDR3
- +5 KILL RAPROC
- +6 QUIT
- +7 ;
- DET2 WRITE !,?31,"----------",?43,"----------",?55,"----------",?67,"----------",!,?4,"Overall:"
- WRITE ?32,$PIECE(RASUM,"^",4),?44,$PIECE(RASUM,"^",2)
- +1 SET X=$PIECE(RASUM,"^",6)\$PIECE(RASUM,"^",5)
- DO MINUTS^RAUTL1
- WRITE ?56,Y,?70,$JUSTIFY($PIECE(RASUM,"^",5),5)
- +2 SET RAXIT=$SELECT($EXTRACT(IOST)="C":$$EOS^RAUTL5(),1:0)
- +3 KILL RASUM
- +4 QUIT
- +5 ;
- CPT SET RACPT=$GET(^RAMIS(71,+RAPRC,0))
- IF RACPT=""
- QUIT
- +1 SET RAZZZ=$PIECE($$NAMCODE^RACPTMSC(+$PIECE(RACPT,"^",9),DT),"^")
- +2 SET RACPT=$EXTRACT($PIECE(RACPT,"^"),1,25)_"("_RAZZZ_")"
- +3 KILL RAZZZ
- +4 QUIT
- +5 ;
- GETLOC() ;P20 by SS
- +1 NEW RA20
- SET RA20="Requesting Location:"
- +2 IF +RA20RLOC=0
- QUIT RA20_"ALL"
- +3 IF +RA20RLOC=1
- QUIT RA20_$EXTRACT($PIECE(RA20RLOC,"^",2),1,16)
- +4 QUIT RA20_"ALL SELECTED"
- GETPROC() ;P20 by SS
- +1 NEW RA20
- SET RA20="Procedure:"
- +2 IF +RAPROCED=0
- SET RA20=RA20_"ALL"
- +3 IF '$TEST
- SET RA20=RA20_$EXTRACT($PIECE(RAPROCED,"^",2),1,25)
- +4 QUIT RA20
- +5 ;
- SUM1 WRITE !,?4,"From: ",$SELECT($DATA(^RA(72,RAFR,0)):$PIECE(^(0),"^"),1:"Unknown"),!,?4,"To : ",$SELECT($DATA(^RA(72,+RATO,0)):$PIECE(^(0),"^"),1:"Unknown")
- +1 WRITE ?32,$PIECE(RASUM,"^",4),?44,$PIECE(RASUM,"^",2)
- +2 SET X=$PIECE(RASUM,"^",6)\$PIECE(RASUM,"^",5)
- DO MINUTS^RAUTL1
- WRITE ?56,Y,?70,$JUSTIFY($PIECE(RASUM,"^",5),5),!
- SET RACTR=RACTR+3
- +3 IF $Y>(IOSL-4)
- SET RAXIT=$SELECT($EXTRACT(IOST)="C":$$EOS^RAUTL5(),1:0)
- IF 'RAXIT
- DO HDR3
- +4 KILL RASUM
- +5 QUIT
- SUM2 WRITE !,?31,"----------",?43,"----------",?55,"----------",?67,"----------",!,?4,"From: ",$SELECT($DATA(^RA(72,+RA(1),0)):$PIECE(^(0),"^"),1:"Unknown"),!,?4,"To : ",$SELECT($DATA(^RA(72,+RA,0)):$PIECE(^(0),"^"),1:"Unknown")
- +1 IF '$DATA(^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"COMPLETE"))
- QUIT
- SET RACOMP=^("COMPLETE")
- WRITE ?32,$PIECE(RACOMP,"^",4),?44,$PIECE(RACOMP,"^",2)
- +2 NEW RAZZSS1
- SET RAZZSS1=^TMP($JOB,"RAST",RAIMAGE,RADV1,RARL,"COUNT")
- +3 SET X=$PIECE(RACOMP,"^",6)\$PIECE(RACOMP,"^",5)
- DO MINUTS^RAUTL1
- WRITE ?56,Y
- +4 IF $Y>(IOSL-2)
- SET RAXIT=$SELECT($EXTRACT(IOST)="C":$$EOS^RAUTL5(),1:0)
- IF 'RAXIT
- DO HDR3
- +5 WRITE !!?4,"Total number of exams moved to a status of COMPLETE"
- +6 WRITE !?4,"for period ",$EXTRACT(BEGDATE,4,5),"/",$EXTRACT(BEGDATE,6,7),"/",$EXTRACT(BEGDATE,2,3)," - ",$EXTRACT(ENDDATE,4,5),"/",$EXTRACT(ENDDATE,6,7),"/",$EXTRACT(ENDDATE,2,3),": ",?70,$JUSTIFY(RAZZSS1,5)
- +7 IF $ORDER(^TMP($JOB,"RASTAT",RADV1))'>0
- QUIT
- +8 SET RAXIT=$SELECT($EXTRACT(IOST)="C":$$EOS^RAUTL5(),1:0)
- +9 QUIT
- +10 ;
- PUTNOST(RAIM1,RADV1,RA20J) ;P20 by SS Display all locations which have not exams
- +1 NEW RA20A,RA20B,RA20C,RA20PASS,RA20FL
- +2 SET RAZZSSFL="NOSTAT"
- +3 SET RA20PASS=0
- SET RA20FL=0
- SET RA20B="There are no statistics for following selected requesting locations:"
- SET $PIECE(RA20C,"-",70)=""
- STRT IF RA20PASS>0
- DO HDR3
- WRITE !?2,RA20B,!?2,RA20C
- +1 SET RA20A=0
- +2 FOR
- SET RA20A=$ORDER(^TMP(RA20J,"RA REQ-LOC",RA20A))
- IF RA20A=""
- GOTO LST
- IF '$$ISTHERE(RAIM1,RADV1,RA20A)
- SET RA20FL=1
- IF RA20PASS=0
- QUIT
- WRITE !?2,RA20A
- IF $Y>(IOSL-4)
- SET RAXIT=$SELECT($EXTRACT(IOST)="C":$$EOS^RAUTL5(),1:0)
- IF RAXIT
- QUIT
- DO HDR3
- WRITE !?2,RA20B,!?2,RA20C
- LST IF RA20PASS>0
- SET RAXIT=$SELECT($EXTRACT(IOST)="C":$$EOS^RAUTL5(),1:0)
- +1 IF RA20PASS=0
- IF RA20FL=0
- QUIT
- +2 IF RA20PASS=0
- SET RA20PASS=1
- GOTO STRT
- +3 QUIT
- ISTHERE(RAIM,RADV,RALOC) ;Does this requesting location have exams is in ^TMP($J..)
- +1 NEW RA20A,RA20B,RA20C
- +2 SET (RA20A,RA20B)=0
- +3 FOR
- SET RA20A=$ORDER(^TMP($JOB,"RAST",RAIM,RADV,RA20A))
- IF RA20A=""
- QUIT
- IF RA20A=RALOC
- SET RA20B=1
- QUIT
- +4 QUIT RA20B
