90 lines
5.8 KiB
Mathematica
90 lines
5.8 KiB
Mathematica
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
|