source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RASTAT.m

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