- RASTAT ;HISC/GJC,FPT,SS AISC/TMP-Status Tracking Statistics Report ;8/4/97 07:59
- ;;5.0;Radiology/Nuclear Medicine;**8,20,24,26**;Mar 16, 1998
- ;last modified by SS OCT 10,2000 P26
- I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
- I $O(RACCESS(DUZ,""))="" D ACCVIO^RAUTL19 Q
- REMOVE F I="RASTAT","DIV-IMG","RA D-TYPE","RAST","RA REQ-LOC" K ^TMP($J,I)
- D SELDIV^RAUTL7 I $O(^TMP($J,"RA D-TYPE",""))=""!$G(RAQUIT) W !!?5,"No divisions selected." G EXIT
- N RA20RLOC S RA20RLOC=$$SELREQ^RASTRPT2() G:+RA20RLOC<0 EXIT ;P20 by SS select requesting locations
- K DIC S DIC="^RA(79.2,",DIC(0)="AEMQZ",DIC("A")="Select IMAGING TYPE: "
- S DIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),($D(RACCESS(DUZ,""IMG"",+Y)))"
- W ! D DIVIACC^RAUTL7,SETUP^RAUTL7A,^DIC K DIC G:Y'>0 EXIT S RAIMAGE=+Y,RAIMAGE(0)=$P(Y(0,0),U)
- S RA(1)=+$O(^RA(72,"AA",RAIMAGE(0),1,0)) I RA(1)'>0 W *7,!,"No 'STATUS #1' in the status file" G EXIT
- S RA=+$O(^RA(72,"AA",RAIMAGE(0),9,0)) I RA'>0 W *7,!,"No 'COMPLETE' status in the status file" G EXIT
- N RAPROCED S RAPROCED=$$SELPROC^RASTRPT2(RAIMAGE) G:RAPROCED<0 EXIT ;P20 by SS select requesting locations
- BP1 D DATE^RAUTL I RAPOP D EXIT Q
- N RADRPTYN S RADRPTYN=$$ASKDTRPT^RASTRPT2 G:RADRPTYN=-1 EXIT ;ask for detailed report P20A
- F I="RA20RLOC","RAPROCED","BEGDATE","ENDDATE","RA","RA(1)","RACCESS*","RAIMAGE","RAIMAGE(0)","^TMP($J,""RA D-TYPE"",","^TMP($J,""RA REQ-LOC""," S ZTSAVE(I)="" ;mod P20 by SS
- S ZTSAVE("^TMP($J,""RA REQ-LOC"",")=""
- S ZTRTN="START^RASTAT" W ! D ZIS^RAUTL I RAPOP D EXIT Q
- START ; start processing
- U IO S RADT=(BEGDATE-1)_".9999",RADT1=ENDDATE_".9999",RAXIT=0
- S:$D(ZTQUEUED) ZTREQ="@"
- S I="" F S I=$O(^TMP($J,"RA D-TYPE",I)) Q:I="" S I(0)=0 F S I(0)=$O(^TMP($J,"RA D-TYPE",I,I(0))) Q:I(0)'>0 S ^TMP($J,"RASTAT",I(0))=0
- K I
- F I=0:0 S RADT=$O(^RADPT("AR",RADT)) Q:RADT>RADT1!(RADT'>0)!(RAXIT) F RADFN=0:0 S RADFN=$O(^RADPT("AR",RADT,RADFN)) Q:RADFN'>0!(RAXIT) F RADTI=0:0 S RADTI=$O(^RADPT("AR",RADT,RADFN,RADTI)) Q:RADTI'>0!(RAXIT) D CASE
- K RADFN,RADT,RADT1,RADTI,RACNI,RASTAT,RADV,RAST1,RAST9,RAFR,RATO,RAPRC
- K RACOMP,RAUT,RAX1
- D:'RAXIT ^RASTRPT
- EXIT ; Kill & quit
- F I="RASTAT","DIV-IMG","RA D-TYPE","RAST","RA REQ-LOC" K ^TMP($J,I)
- K ^TMP($J,"RA REQ-LOC")
- K %DT,BEGDATE,C,ENDDATE,DIROUT,DIRUT,DTOUT,DUOUT,RA,RAIMAGE,RAMES,X,Y
- K ZTDESC,ZTSAVE,ZTRTN,ZTSK
- K I,RAPOP,RAQUIT K:$D(RAPSTX) RACCESS,RAPSTX,POP
- Q
- CASE S X=$G(^RADPT(RADFN,"DT",RADTI,0)),X(2)=+$P(X,U,2),X(3)=+$P(X,U,3)
- I X(2)'=RAIMAGE Q
- S (RADIVN,RADV,Y)=X(3),C=$P(^DD(70.02,3,0),U,2) D Y^DIQ S RADIVN(0)=Y
- I $D(^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN))[0 Q
- ;Search for exams IF status=2 (COMPLETED) do STATUS
- F RACNI=0:0 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!(RAXIT) I $D(^(RACNI,0)) S X1=^(0) I $$ISOK()=1 D STATUS Q:RAXIT D:$D(RAST1)&($D(RAST9)) UPD2 ;modif P20 by SS
- Q
- ISOK() ;P20 by SS
- Q:$P(X1,"^",3)'=RA 0
- Q:+RA20RLOC<0 0
- I +RA20RLOC=1 I $P(X1,"^",22)'=$P(RA20RLOC,"^",3) Q 0
- I +RA20RLOC>1 I $$ISLOCOK^RASTRPT2($P(X1,"^",22),$J)=0 Q 0 ;if it isn't selected location
- I (+RAPROCED'=0)&(+RAPROCED'=$P(X1,"^",2)) Q 0
- N RA11A,RA11B
- S RA11A=$P(X1,"^",22) ; P26
- S RA11B=$S(RA11A="":"Unknown",1:$E($P(^SC(RA11A,0),"^",1),1,200))
- S ^TMP($J,"RAST",RAIMAGE,RADV,RA11B,"COUNT")=$G(^TMP($J,"RAST",RAIMAGE,RADV,RA11B,"COUNT"),0)+1
- Q 1
- STATUS K RAUT,RAFR,RAST1,RAST9 S RAPRC=$P(X1,"^",2)
- F RASTAT=0:0 S RASTAT=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T",RASTAT)) Q:RASTAT'>0!(RAXIT) I $D(^(RASTAT,0)) S Y(0)=^(0) D:$D(RAFR) UPD1 Q:RAXIT I '$D(RAFR) S RAFR=+$P(Y(0),"^",2),X=+Y(0)
- Q:'$D(RAUT) F RAFR=0:0 S RAFR=$O(RAUT(RAFR)) Q:RAFR'>0!(RAXIT) F RATO=0:0 S RATO=$O(RAUT(RAFR,RATO)) Q:RATO'>0!(RAXIT) S Y1=+RAUT(RAFR,RATO),Y=$P(RAUT(RAFR,RATO),"^",2) D STATS
- Q
- UPD1 ; Update ^TMP global for procedure data
- I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
- S:RAFR=RA(1)&('$D(RAST1)) RAST1=X S RATO=+$P(Y(0),"^",2),X1=+Y(0),RAX1=X1 Q:RAFR=RATO!(RAFR=0)!(RATO=0) D ELAPSED^RAUTL1 S X=RAX1 I Y1<0!('$D(RAMTIME)) S RAFR=RATO Q
- D SETTMP^RASTRPT2 ;Q:RACURREC=0 ;P20 by SS
- S:RATO=RA RAST9=X I '$D(^TMP($J,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)) S ^(RAPRC)=Y1_"^"_Y_"^"_Y1_"^"_Y_"^0^0"
- I '$D(^TMP($J,"RASTAT",RADV,"SUM",RAFR,RATO)) S ^(RATO)=Y1_"^"_Y_"^"_Y1_"^"_Y_"^0^0"
- I $D(RAUT(RAFR,RATO)) S X=Y1+(+RAUT(RAFR,RATO)),Y1=X D MINUTS^RAUTL1 S RAUT(RAFR,RATO)=Y1_"^"_Y,X=RAX1
- S:'$D(RAUT(RAFR,RATO)) RAUT(RAFR,RATO)=Y1_"^"_Y
- S RAFR=RATO Q
- STATS ; Update the division and procedure ^TMP globals
- I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
- S RASUM=^TMP($J,"RASTAT",RADV,"SUM",RAFR,RATO),RAPROC=^TMP($J,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)
- S ^TMP($J,"RASTAT",RADV)=^TMP($J,"RASTAT",RADV)+1 ;ft 9/30/94
- ;MAXIMUM AMOUNT OF ELAPSED TIME
- S:Y1>+RAPROC RAPROC=Y1_"^"_Y_"^"_$P(RAPROC,"^",3,6)
- S:Y1>+RASUM RASUM=Y1_"^"_Y_"^"_$P(RASUM,"^",3,6)
- ;MINIMUM AMOUNT OF ELAPSED TIME
- S:Y1<+$P(RAPROC,"^",3) RAPROC=$P(RAPROC,"^",1,2)_"^"_Y1_"^"_Y_"^"_$P(RAPROC,"^",5,6)
- S:Y1<+$P(RASUM,"^",3) RASUM=$P(RASUM,"^",1,2)_"^"_Y1_"^"_Y_"^"_$P(RASUM,"^",5,6)
- ;TOTAL # OF PROCEDURES AND TOTAL # OF ELAPSED MINUTES
- S RAPROC=$P(RAPROC,"^",1,4)_"^"_($P(RAPROC,"^",5)+1)_"^"_(+$P(RAPROC,"^",6)+Y1)
- S RASUM=$P(RASUM,"^",1,4)_"^"_(+$P(RASUM,"^",5)+1)_"^"_(+$P(RASUM,"^",6)+Y1)
- S ^TMP($J,"RASTAT",RADV,"SUM",RAFR,RATO)=RASUM,^TMP($J,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)=RAPROC K RAPROC,RASUM
- Q
- UPD2 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
- K RACOMP S X=RAST1,X1=RAST9 D ELAPSED^RAUTL1 Q:Y1<0!('$D(RAMTIME))
- I '$D(^TMP($J,"RASTAT",RADV,"COMPLETE")) S ^("COMPLETE")=Y1_"^"_Y_"^"_Y1_"^"_Y_"^1^"_Y1 Q
- S RACOMP=^TMP($J,"RASTAT",RADV,"COMPLETE"),RACOMP=$P(RACOMP,"^",1,4)_"^"_($P(RACOMP,"^",5)+1)_"^"_($P(RACOMP,"^",6)+Y1)
- S:Y1>+RACOMP RACOMP=Y1_"^"_Y_"^"_$P(RACOMP,"^",3,6)
- S:Y1<+$P(RACOMP,"^",3) RACOMP=$P(RACOMP,"^",1,2)_"^"_Y1_"^"_Y_"^"_$P(RACOMP,"^",5,6)
- S ^TMP($J,"RASTAT",RADV,"COMPLETE")=RACOMP
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRASTAT 5979 printed Feb 19, 2025@00:06:06 Page 2
- RASTAT ;HISC/GJC,FPT,SS AISC/TMP-Status Tracking Statistics Report ;8/4/97 07:59
- +1 ;;5.0;Radiology/Nuclear Medicine;**8,20,24,26**;Mar 16, 1998
- +2 ;last modified by SS OCT 10,2000 P26
- +3 IF $ORDER(RACCESS(DUZ,""))=""
- DO SETVARS^RAPSET1(0)
- SET RAPSTX=""
- +4 IF $ORDER(RACCESS(DUZ,""))=""
- DO ACCVIO^RAUTL19
- QUIT
- REMOVE FOR I="RASTAT","DIV-IMG","RA D-TYPE","RAST","RA REQ-LOC"
- KILL ^TMP($JOB,I)
- +1 DO SELDIV^RAUTL7
- IF $ORDER(^TMP($JOB,"RA D-TYPE",""))=""!$GET(RAQUIT)
- WRITE !!?5,"No divisions selected."
- GOTO EXIT
- +2 ;P20 by SS select requesting locations
- NEW RA20RLOC
- SET RA20RLOC=$$SELREQ^RASTRPT2()
- if +RA20RLOC<0
- GOTO EXIT
- +3 KILL DIC
- SET DIC="^RA(79.2,"
- SET DIC(0)="AEMQZ"
- SET DIC("A")="Select IMAGING TYPE: "
- +4 SET DIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),($D(RACCESS(DUZ,""IMG"",+Y)))"
- +5 WRITE !
- DO DIVIACC^RAUTL7
- DO SETUP^RAUTL7A
- DO ^DIC
- KILL DIC
- if Y'>0
- GOTO EXIT
- SET RAIMAGE=+Y
- SET RAIMAGE(0)=$PIECE(Y(0,0),U)
- +6 SET RA(1)=+$ORDER(^RA(72,"AA",RAIMAGE(0),1,0))
- IF RA(1)'>0
- WRITE *7,!,"No 'STATUS #1' in the status file"
- GOTO EXIT
- +7 SET RA=+$ORDER(^RA(72,"AA",RAIMAGE(0),9,0))
- IF RA'>0
- WRITE *7,!,"No 'COMPLETE' status in the status file"
- GOTO EXIT
- +8 ;P20 by SS select requesting locations
- NEW RAPROCED
- SET RAPROCED=$$SELPROC^RASTRPT2(RAIMAGE)
- if RAPROCED<0
- GOTO EXIT
- BP1 DO DATE^RAUTL
- IF RAPOP
- DO EXIT
- QUIT
- +1 ;ask for detailed report P20A
- NEW RADRPTYN
- SET RADRPTYN=$$ASKDTRPT^RASTRPT2
- if RADRPTYN=-1
- GOTO EXIT
- +2 ;mod P20 by SS
- FOR I="RA20RLOC","RAPROCED","BEGDATE","ENDDATE","RA","RA(1)","RACCESS*","RAIMAGE","RAIMAGE(0)","^TMP($J,""RA D-TYPE"",","^TMP($J,""RA REQ-LOC"","
- SET ZTSAVE(I)=""
- +3 SET ZTSAVE("^TMP($J,""RA REQ-LOC"",")=""
- +4 SET ZTRTN="START^RASTAT"
- WRITE !
- DO ZIS^RAUTL
- IF RAPOP
- DO EXIT
- QUIT
- START ; start processing
- +1 USE IO
- SET RADT=(BEGDATE-1)_".9999"
- SET RADT1=ENDDATE_".9999"
- SET RAXIT=0
- +2 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 SET I=""
- FOR
- SET I=$ORDER(^TMP($JOB,"RA D-TYPE",I))
- if I=""
- QUIT
- SET I(0)=0
- FOR
- SET I(0)=$ORDER(^TMP($JOB,"RA D-TYPE",I,I(0)))
- if I(0)'>0
- QUIT
- SET ^TMP($JOB,"RASTAT",I(0))=0
- +4 KILL I
- +5 FOR I=0:0
- SET RADT=$ORDER(^RADPT("AR",RADT))
- if RADT>RADT1!(RADT'>0)!(RAXIT)
- QUIT
- FOR RADFN=0:0
- SET RADFN=$ORDER(^RADPT("AR",RADT,RADFN))
- if RADFN'>0!(RAXIT)
- QUIT
- FOR RADTI=0:0
- SET RADTI=$ORDER(^RADPT("AR",RADT,RADFN,RADTI))
- if RADTI'>0!(RAXIT)
- QUIT
- DO CASE
- +6 KILL RADFN,RADT,RADT1,RADTI,RACNI,RASTAT,RADV,RAST1,RAST9,RAFR,RATO,RAPRC
- +7 KILL RACOMP,RAUT,RAX1
- +8 if 'RAXIT
- DO ^RASTRPT
- EXIT ; Kill & quit
- +1 FOR I="RASTAT","DIV-IMG","RA D-TYPE","RAST","RA REQ-LOC"
- KILL ^TMP($JOB,I)
- +2 KILL ^TMP($JOB,"RA REQ-LOC")
- +3 KILL %DT,BEGDATE,C,ENDDATE,DIROUT,DIRUT,DTOUT,DUOUT,RA,RAIMAGE,RAMES,X,Y
- +4 KILL ZTDESC,ZTSAVE,ZTRTN,ZTSK
- +5 KILL I,RAPOP,RAQUIT
- if $DATA(RAPSTX)
- KILL RACCESS,RAPSTX,POP
- +6 QUIT
- CASE SET X=$GET(^RADPT(RADFN,"DT",RADTI,0))
- SET X(2)=+$PIECE(X,U,2)
- SET X(3)=+$PIECE(X,U,3)
- +1 IF X(2)'=RAIMAGE
- QUIT
- +2 SET (RADIVN,RADV,Y)=X(3)
- SET C=$PIECE(^DD(70.02,3,0),U,2)
- DO Y^DIQ
- SET RADIVN(0)=Y
- +3 IF $DATA(^TMP($JOB,"RA D-TYPE",RADIVN(0),RADIVN))[0
- QUIT
- +4 ;Search for exams IF status=2 (COMPLETED) do STATUS
- +5 ;modif P20 by SS
- FOR RACNI=0:0
- SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
- if RACNI'>0!(RAXIT)
- QUIT
- IF $DATA(^(RACNI,0))
- SET X1=^(0)
- IF $$ISOK()=1
- DO STATUS
- if RAXIT
- QUIT
- if $DATA(RAST1)&($DATA(RAST9))
- DO UPD2
- +6 QUIT
- ISOK() ;P20 by SS
- +1 if $PIECE(X1,"^",3)'=RA
- QUIT 0
- +2 if +RA20RLOC<0
- QUIT 0
- +3 IF +RA20RLOC=1
- IF $PIECE(X1,"^",22)'=$PIECE(RA20RLOC,"^",3)
- QUIT 0
- +4 ;if it isn't selected location
- IF +RA20RLOC>1
- IF $$ISLOCOK^RASTRPT2($PIECE(X1,"^",22),$JOB)=0
- QUIT 0
- +5 IF (+RAPROCED'=0)&(+RAPROCED'=$PIECE(X1,"^",2))
- QUIT 0
- +6 NEW RA11A,RA11B
- +7 ; P26
- SET RA11A=$PIECE(X1,"^",22)
- +8 SET RA11B=$SELECT(RA11A="":"Unknown",1:$EXTRACT($PIECE(^SC(RA11A,0),"^",1),1,200))
- +9 SET ^TMP($JOB,"RAST",RAIMAGE,RADV,RA11B,"COUNT")=$GET(^TMP($JOB,"RAST",RAIMAGE,RADV,RA11B,"COUNT"),0)+1
- +10 QUIT 1
- STATUS KILL RAUT,RAFR,RAST1,RAST9
- SET RAPRC=$PIECE(X1,"^",2)
- +1 FOR RASTAT=0:0
- SET RASTAT=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"T",RASTAT))
- if RASTAT'>0!(RAXIT)
- QUIT
- IF $DATA(^(RASTAT,0))
- SET Y(0)=^(0)
- if $DATA(RAFR)
- DO UPD1
- if RAXIT
- QUIT
- IF '$DATA(RAFR)
- SET RAFR=+$PIECE(Y(0),"^",2)
- SET X=+Y(0)
- +2 if '$DATA(RAUT)
- QUIT
- FOR RAFR=0:0
- SET RAFR=$ORDER(RAUT(RAFR))
- if RAFR'>0!(RAXIT)
- QUIT
- FOR RATO=0:0
- SET RATO=$ORDER(RAUT(RAFR,RATO))
- if RATO'>0!(RAXIT)
- QUIT
- SET Y1=+RAUT(RAFR,RATO)
- SET Y=$PIECE(RAUT(RAFR,RATO),"^",2)
- DO STATS
- +3 QUIT
- UPD1 ; Update ^TMP global for procedure data
- +1 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- if $GET(ZTSTOP)=1
- SET RAXIT=1
- if RAXIT
- QUIT
- +2 if RAFR=RA(1)&('$DATA(RAST1))
- SET RAST1=X
- SET RATO=+$PIECE(Y(0),"^",2)
- SET X1=+Y(0)
- SET RAX1=X1
- if RAFR=RATO!(RAFR=0)!(RATO=0)
- QUIT
- DO ELAPSED^RAUTL1
- SET X=RAX1
- IF Y1<0!('$DATA(RAMTIME))
- SET RAFR=RATO
- QUIT
- +3 ;Q:RACURREC=0 ;P20 by SS
- DO SETTMP^RASTRPT2
- +4 if RATO=RA
- SET RAST9=X
- IF '$DATA(^TMP($JOB,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC))
- SET ^(RAPRC)=Y1_"^"_Y_"^"_Y1_"^"_Y_"^0^0"
- +5 IF '$DATA(^TMP($JOB,"RASTAT",RADV,"SUM",RAFR,RATO))
- SET ^(RATO)=Y1_"^"_Y_"^"_Y1_"^"_Y_"^0^0"
- +6 IF $DATA(RAUT(RAFR,RATO))
- SET X=Y1+(+RAUT(RAFR,RATO))
- SET Y1=X
- DO MINUTS^RAUTL1
- SET RAUT(RAFR,RATO)=Y1_"^"_Y
- SET X=RAX1
- +7 if '$DATA(RAUT(RAFR,RATO))
- SET RAUT(RAFR,RATO)=Y1_"^"_Y
- +8 SET RAFR=RATO
- QUIT
- STATS ; Update the division and procedure ^TMP globals
- +1 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- if $GET(ZTSTOP)=1
- SET RAXIT=1
- if RAXIT
- QUIT
- +2 SET RASUM=^TMP($JOB,"RASTAT",RADV,"SUM",RAFR,RATO)
- SET RAPROC=^TMP($JOB,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)
- +3 ;ft 9/30/94
- SET ^TMP($JOB,"RASTAT",RADV)=^TMP($JOB,"RASTAT",RADV)+1
- +4 ;MAXIMUM AMOUNT OF ELAPSED TIME
- +5 if Y1>+RAPROC
- SET RAPROC=Y1_"^"_Y_"^"_$PIECE(RAPROC,"^",3,6)
- +6 if Y1>+RASUM
- SET RASUM=Y1_"^"_Y_"^"_$PIECE(RASUM,"^",3,6)
- +7 ;MINIMUM AMOUNT OF ELAPSED TIME
- +8 if Y1<+$PIECE(RAPROC,"^",3)
- SET RAPROC=$PIECE(RAPROC,"^",1,2)_"^"_Y1_"^"_Y_"^"_$PIECE(RAPROC,"^",5,6)
- +9 if Y1<+$PIECE(RASUM,"^",3)
- SET RASUM=$PIECE(RASUM,"^",1,2)_"^"_Y1_"^"_Y_"^"_$PIECE(RASUM,"^",5,6)
- +10 ;TOTAL # OF PROCEDURES AND TOTAL # OF ELAPSED MINUTES
- +11 SET RAPROC=$PIECE(RAPROC,"^",1,4)_"^"_($PIECE(RAPROC,"^",5)+1)_"^"_(+$PIECE(RAPROC,"^",6)+Y1)
- +12 SET RASUM=$PIECE(RASUM,"^",1,4)_"^"_(+$PIECE(RASUM,"^",5)+1)_"^"_(+$PIECE(RASUM,"^",6)+Y1)
- +13 SET ^TMP($JOB,"RASTAT",RADV,"SUM",RAFR,RATO)=RASUM
- SET ^TMP($JOB,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)=RAPROC
- KILL RAPROC,RASUM
- +14 QUIT
- UPD2 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- if $GET(ZTSTOP)=1
- SET RAXIT=1
- if RAXIT
- QUIT
- +1 KILL RACOMP
- SET X=RAST1
- SET X1=RAST9
- DO ELAPSED^RAUTL1
- if Y1<0!('$DATA(RAMTIME))
- QUIT
- +2 IF '$DATA(^TMP($JOB,"RASTAT",RADV,"COMPLETE"))
- SET ^("COMPLETE")=Y1_"^"_Y_"^"_Y1_"^"_Y_"^1^"_Y1
- QUIT
- +3 SET RACOMP=^TMP($JOB,"RASTAT",RADV,"COMPLETE")
- SET RACOMP=$PIECE(RACOMP,"^",1,4)_"^"_($PIECE(RACOMP,"^",5)+1)_"^"_($PIECE(RACOMP,"^",6)+Y1)
- +4 if Y1>+RACOMP
- SET RACOMP=Y1_"^"_Y_"^"_$PIECE(RACOMP,"^",3,6)
- +5 if Y1<+$PIECE(RACOMP,"^",3)
- SET RACOMP=$PIECE(RACOMP,"^",1,2)_"^"_Y1_"^"_Y_"^"_$PIECE(RACOMP,"^",5,6)
- +6 SET ^TMP($JOB,"RASTAT",RADV,"COMPLETE")=RACOMP
- +7 QUIT