source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAMIS.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1RAMIS ;HISC/CAH,GJC,FPT AISC/MJK-Radiology AMIS Report ;4/15/96 12:49
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
4 I $O(RACCESS(DUZ,""))="" D ACCVIO^RAUTL19 Q
5 W !!,"NOTE: This output should be queued to a printer that supports 132 columns.",!
6 D CHK^RAMIS2 I '$D(RADFLAG) G Q^RAMIS1
7 S ZTRTN="START^RAMIS",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("^TMP($J,""RA D-TYPE"",")="" D DATE^RAUTL G:RAPOP Q^RAMIS1
8 D SHOWSTAT
9DEV W ! D ZIS^RAUTL G:RAPOP Q^RAMIS1
10START ; Start processing here
11 S:$D(ZTQUEUED) ZTREQ="@"
12 U IO K ^TMP($J,"RAMIS") S RAXIT=0
13 S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999,D="TOT",RACRT=8
14 D CRIT^RAUTL1 D INIT
15 F RADTE=RABEG:0:RAEND S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND) D Q:RAXIT
16 . S RADFN=0
17 . F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0 D RADTI Q:RAXIT
18 . Q
19 G:'RAXIT ^RAMIS1
20 G Q^RAMIS1
21 ;
22RADTI ; Obtain the Registered Exams node
23 F RADTI=0:0 K RA20,RABILAT,RA21H,RA21B,RAOR,RAPORT,RAORFL,RAPORTFL,RAVST,RACPT S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0!(RAXIT) I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAD0=^(0) D RACNI
24 Q
25RACNI ; Obtain the Examinations node
26 S (RADIVN,Y)=+$P(RAD0,U,3) Q:RADIVN'>0
27 S C=$P(^DD(70.02,3,0),U,2) D Y^DIQ Q:Y="" S RADIVN(0)=Y
28 I $D(^TMP($J,"RA D-TYPE",RADIVN(0),RADIVN))[0 Q
29 F RACNI=0:0 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!(RAXIT) I $D(^(RACNI,0)) S RAP0=^(0) D CHK:$D(RACRT(+$P(RAP0,"^",3)))
30 Q
31 ;
32CHK I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
33 S RADIV=$S($D(^RA(79,+$P(RAD0,"^",3),0)):+$P(RAD0,"^",3),1:99) I '$D(^TMP($J,"RAMIS",RADIV)) S D=RADIV D INIT
34 S C=$S($D(^DIC(42,+$P(RAP0,"^",6),0)):"IN",1:"OUT")
35 I '$D(RAVST) S RAVST="" F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,"VST",C)+1
36 F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"F",I)) Q:I'>0!(RAXIT) I $D(^(I,0)) S X=^(0) I $D(^RA(78.4,+X,0)) S T=$S($P(^(0),"^",2)'="Y":"FLM",1:"CINE"),X=+$P(X,"^",2) D FLM
37 F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"M",I)) Q:I'>0 I $D(^(I,0)) S RAQI=+^(0) D EXTRA^RAUTL12(RAQI)
38 Q:'$D(^RAMIS(71,+$P(RAP0,"^",2),0)) S RAPRI=^(0),RAPRC=$E($P(RAPRI,"^"),1,30) Q:'$D(^(2))!($D(RACPT(+$P(RAPRI,"^",9)))) S RACPT(+$P(RAPRI,"^",9))=""
39 F I=0:0 S I=$O(^RAMIS(71,+$P(RAP0,"^",2),2,I)) Q:I'>0!(RAXIT) I $D(^(I,0)) S RAZ=^(0),RAMJ=$S($D(^RAMIS(71.1,+RAZ,0)):^(0),1:"") D RAPRC
40 Q:'$D(RAMIS(1)) F I=0:0 S I=$O(RAMIS(I)) Q:I'>0!(RAXIT) S A=RAMIS(I),RAWT=RAWT(I),RAMUL=RAMUL(I),RACT=RACT(I) D STORE
41 K RAMIS,RAWT,RAMUL,RACT,RAZ,RAMJ,RAMULP,RAMULPFL,RAPORT,RAOR,RABILAT,RA21H,RA21B,RA20 Q
42 ;
43STORE ; Store data into ^TMP($J,"RAMIS")
44 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
45 I A=20,$D(RA20) Q
46 I A=21,$D(RA21H),RACT="H" Q
47 I A=21,$D(RA21B),RACT="B" Q
48 S:A=20 RA20="" I A=21 S:RACT="H" RA21H="" S:RACT="B" RA21B=""
49 I '$D(RAORFL),$D(RAOR) S RAORFL="" F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,25,"EX",C)+1
50 I '$D(RAPORTFL),$D(RAPORT) S RAPORTFL="" F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,26,"EX",C)+1
51 I '$D(RAMULPFL),$D(RAMULP) S RAMULPFL="" F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,"MULP","EX",C)+1
52 F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,A,"EX",C)+RAMUL
53 F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,A,"WT",C)+(RAMUL*RAWT)
54 I $D(RAOR) F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,25,"WT",C)+(RAMUL*RAWT)
55 I $D(RAPORT) F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,26,"WT",C)+(RAMUL*RAWT)
56 I $D(RAMULP) F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,"MULP","WT",C)+(RAMUL*RAWT)
57 F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,"TOT","EX",C)+RAMUL
58 F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,"TOT","WT",C)+(RAMUL*RAWT)
59 Q
60 ;
61INIT ; Initialize the ^TMP($J,"RAMIS" global to zero.
62 F A=1:1:27,99,"TOT","MULP" F T="EX","WT" F C="IN","OUT" S ^TMP($J,"RAMIS",D,A,T,C)=0
63 F T="FLM","CINE","CINERUNS","VST" F C="IN","OUT" S ^TMP($J,"RAMIS",D,T,C)=0
64 Q
65 ;
66RAPRC I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
67 I +RAZ=25 S RAOR="" Q
68 I +RAZ=26 S RAPORT="" Q
69 S:$P(RAZ,U,3)="Y" RABILAT="" F J=1:1 I '$D(RAMIS(J)) S RAMIS(J)=$S(RAMJ]"":+RAZ,1:99),RAWT(J)=+$P(RAMJ,U,2),RAMUL(J)=$S(+$P(RAZ,U,2)>0:+$P(RAZ,U,2),1:1) S:$D(RABILAT)&(RAMUL(J)<2) RAMUL(J)=RAMUL(J)*2 S RACT(J)=$P(RAZ,U,4) S:J>1 RAMULP="" Q
70 K RABILAT
71 Q
72 ;
73FLM I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 Q:RAXIT
74 F D=RADIV,"TOT" S ^(C)=^TMP($J,"RAMIS",D,T,C)+X S:T="CINE" ^(C)=^TMP($J,"RAMIS",D,"CINERUNS",C)+1
75 Q
76SHOWSTAT ;
77 K ^TMP($J,"RA I-TYPE") N RA2,RAXIT S (RA2,RAXIT)=""
78 F S RA2=$O(^RA(72,"AA",RA2)) Q:RA2="" S ^TMP($J,"RA I-TYPE",RA2)=""
79 D DISPXAM^RALWKL1(8) K ^TMP($J,"RA I-TYPE")
80 Q
Note: See TracBrowser for help on using the repository browser.