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

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1RASTAT ;HISC/GJC,FPT,SS AISC/TMP-Status Tracking Statistics Report ;8/4/97 07:59
2 ;;5.0;Radiology/Nuclear Medicine;**8,20,24,26**;Mar 16, 1998
3 ;last modified by SS OCT 10,2000 P26
4 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
5 I $O(RACCESS(DUZ,""))="" D ACCVIO^RAUTL19 Q
6REMOVE F I="RASTAT","DIV-IMG","RA D-TYPE","RAST","RA REQ-LOC" K ^TMP($J,I)
7 D SELDIV^RAUTL7 I $O(^TMP($J,"RA D-TYPE",""))=""!$G(RAQUIT) W !!?5,"No divisions selected." G EXIT
8 N RA20RLOC S RA20RLOC=$$SELREQ^RASTRPT2() G:+RA20RLOC<0 EXIT ;P20 by SS select requesting locations
9 K DIC S DIC="^RA(79.2,",DIC(0)="AEMQZ",DIC("A")="Select IMAGING TYPE: "
10 S DIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),($D(RACCESS(DUZ,""IMG"",+Y)))"
11 W ! D DIVIACC^RAUTL7,SETUP^RAUTL7A,^DIC K DIC G:Y'>0 EXIT S RAIMAGE=+Y,RAIMAGE(0)=$P(Y(0,0),U)
12 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
13 S RA=+$O(^RA(72,"AA",RAIMAGE(0),9,0)) I RA'>0 W *7,!,"No 'COMPLETE' status in the status file" G EXIT
14 N RAPROCED S RAPROCED=$$SELPROC^RASTRPT2(RAIMAGE) G:RAPROCED<0 EXIT ;P20 by SS select requesting locations
15BP1 D DATE^RAUTL I RAPOP D EXIT Q
16 N RADRPTYN S RADRPTYN=$$ASKDTRPT^RASTRPT2 G:RADRPTYN=-1 EXIT ;ask for detailed report P20A
17 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
18 S ZTSAVE("^TMP($J,""RA REQ-LOC"",")=""
19 S ZTRTN="START^RASTAT" W ! D ZIS^RAUTL I RAPOP D EXIT Q
20START ; start processing
21 U IO S RADT=(BEGDATE-1)_".9999",RADT1=ENDDATE_".9999",RAXIT=0
22 S:$D(ZTQUEUED) ZTREQ="@"
23 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
24 K I
25 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
26 K RADFN,RADT,RADT1,RADTI,RACNI,RASTAT,RADV,RAST1,RAST9,RAFR,RATO,RAPRC
27 K RACOMP,RAUT,RAX1
28 D:'RAXIT ^RASTRPT
29EXIT ; Kill & quit
30 F I="RASTAT","DIV-IMG","RA D-TYPE","RAST","RA REQ-LOC" K ^TMP($J,I)
31 K ^TMP($J,"RA REQ-LOC")
32 K %DT,BEGDATE,C,ENDDATE,DIROUT,DIRUT,DTOUT,DUOUT,RA,RAIMAGE,RAMES,X,Y
33 K ZTDESC,ZTSAVE,ZTRTN,ZTSK
34 K I,RAPOP,RAQUIT K:$D(RAPSTX) RACCESS,RAPSTX,POP
35 Q
36CASE S X=$G(^RADPT(RADFN,"DT",RADTI,0)),X(2)=+$P(X,U,2),X(3)=+$P(X,U,3)
37 I X(2)'=RAIMAGE Q
38 S (RADIVN,RADV,Y)=X(3),C=$P(^DD(70.02,3,0),U,2) D Y^DIQ S RADIVN(0)=Y
39 I $D(^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN))[0 Q
40 ;Search for exams IF status=2 (COMPLETED) do STATUS
41 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
42 Q
43ISOK() ;P20 by SS
44 Q:$P(X1,"^",3)'=RA 0
45 Q:+RA20RLOC<0 0
46 I +RA20RLOC=1 I $P(X1,"^",22)'=$P(RA20RLOC,"^",3) Q 0
47 I +RA20RLOC>1 I $$ISLOCOK^RASTRPT2($P(X1,"^",22),$J)=0 Q 0 ;if it isn't selected location
48 I (+RAPROCED'=0)&(+RAPROCED'=$P(X1,"^",2)) Q 0
49 N RA11A,RA11B
50 S RA11A=$P(X1,"^",22) ; P26
51 S RA11B=$S(RA11A="":"Unknown",1:$E($P(^SC(RA11A,0),"^",1),1,200))
52 S ^TMP($J,"RAST",RAIMAGE,RADV,RA11B,"COUNT")=$G(^TMP($J,"RAST",RAIMAGE,RADV,RA11B,"COUNT"),0)+1
53 Q 1
54STATUS K RAUT,RAFR,RAST1,RAST9 S RAPRC=$P(X1,"^",2)
55 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)
56 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
57 Q
58UPD1 ; Update ^TMP global for procedure data
59 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
60 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
61 D SETTMP^RASTRPT2 ;Q:RACURREC=0 ;P20 by SS
62 S:RATO=RA RAST9=X I '$D(^TMP($J,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)) S ^(RAPRC)=Y1_"^"_Y_"^"_Y1_"^"_Y_"^0^0"
63 I '$D(^TMP($J,"RASTAT",RADV,"SUM",RAFR,RATO)) S ^(RATO)=Y1_"^"_Y_"^"_Y1_"^"_Y_"^0^0"
64 I $D(RAUT(RAFR,RATO)) S X=Y1+(+RAUT(RAFR,RATO)),Y1=X D MINUTS^RAUTL1 S RAUT(RAFR,RATO)=Y1_"^"_Y,X=RAX1
65 S:'$D(RAUT(RAFR,RATO)) RAUT(RAFR,RATO)=Y1_"^"_Y
66 S RAFR=RATO Q
67STATS ; Update the division and procedure ^TMP globals
68 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
69 S RASUM=^TMP($J,"RASTAT",RADV,"SUM",RAFR,RATO),RAPROC=^TMP($J,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)
70 S ^TMP($J,"RASTAT",RADV)=^TMP($J,"RASTAT",RADV)+1 ;ft 9/30/94
71 ;MAXIMUM AMOUNT OF ELAPSED TIME
72 S:Y1>+RAPROC RAPROC=Y1_"^"_Y_"^"_$P(RAPROC,"^",3,6)
73 S:Y1>+RASUM RASUM=Y1_"^"_Y_"^"_$P(RASUM,"^",3,6)
74 ;MINIMUM AMOUNT OF ELAPSED TIME
75 S:Y1<+$P(RAPROC,"^",3) RAPROC=$P(RAPROC,"^",1,2)_"^"_Y1_"^"_Y_"^"_$P(RAPROC,"^",5,6)
76 S:Y1<+$P(RASUM,"^",3) RASUM=$P(RASUM,"^",1,2)_"^"_Y1_"^"_Y_"^"_$P(RASUM,"^",5,6)
77 ;TOTAL # OF PROCEDURES AND TOTAL # OF ELAPSED MINUTES
78 S RAPROC=$P(RAPROC,"^",1,4)_"^"_($P(RAPROC,"^",5)+1)_"^"_(+$P(RAPROC,"^",6)+Y1)
79 S RASUM=$P(RASUM,"^",1,4)_"^"_(+$P(RASUM,"^",5)+1)_"^"_(+$P(RASUM,"^",6)+Y1)
80 S ^TMP($J,"RASTAT",RADV,"SUM",RAFR,RATO)=RASUM,^TMP($J,"RASTAT",RADV,"PROC",RAFR,RATO,RAPRC)=RAPROC K RAPROC,RASUM
81 Q
82UPD2 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
83 K RACOMP S X=RAST1,X1=RAST9 D ELAPSED^RAUTL1 Q:Y1<0!('$D(RAMTIME))
84 I '$D(^TMP($J,"RASTAT",RADV,"COMPLETE")) S ^("COMPLETE")=Y1_"^"_Y_"^"_Y1_"^"_Y_"^1^"_Y1 Q
85 S RACOMP=^TMP($J,"RASTAT",RADV,"COMPLETE"),RACOMP=$P(RACOMP,"^",1,4)_"^"_($P(RACOMP,"^",5)+1)_"^"_($P(RACOMP,"^",6)+Y1)
86 S:Y1>+RACOMP RACOMP=Y1_"^"_Y_"^"_$P(RACOMP,"^",3,6)
87 S:Y1<+$P(RACOMP,"^",3) RACOMP=$P(RACOMP,"^",1,2)_"^"_Y1_"^"_Y_"^"_$P(RACOMP,"^",5,6)
88 S ^TMP($J,"RASTAT",RADV,"COMPLETE")=RACOMP
89 Q
Note: See TracBrowser for help on using the repository browser.