72 lines
4.4 KiB
Mathematica
72 lines
4.4 KiB
Mathematica
RAPRC ;HISC/FPT AISC/MJK-Radiology Procedure Workload Report ;6/18/97 09:57
|
|
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
|
|
;
|
|
; called by RA WKLPROCEDURE
|
|
;
|
|
K ^TMP($J,"RA"),^TMP($J,"RAPRC"),^TMP($J,"DIV-IMG")
|
|
I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
|
|
S X=$$SETUPDI^RAUTL7() I X D Q^RAPRC1 Q
|
|
D SELDIV^RAUTL7 I '$D(^TMP($J,"RA D-TYPE"))!($G(RAQUIT)) D Q^RAPRC1 Q
|
|
D IT I RAITYPE="" D Q^RAPRC1 Q
|
|
S A=""
|
|
F S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']"" D
|
|
.Q:'$D(^TMP($J,"RA D-TYPE",A)) S A1=$O(^TMP($J,"RA D-TYPE",A,0))
|
|
.Q:A1'>0 S B=""
|
|
.F S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']"" D
|
|
..I B=RAITYPE S ^TMP($J,"RAPRC",A1)=0
|
|
I '$D(^TMP($J,"RAPRC")) D Q^RAPRC1 Q
|
|
K A,A1,B
|
|
D DATE^RAUTL I RAPOP D Q^RAPRC1 Q
|
|
S RAXIT=0 D DISPXAM^RALWKL1(9) I RAXIT D Q^RAPRC1 Q
|
|
S ZTDESC="Rad/Nuc Med PROCEDURE WORKLOAD RPT",ZTRTN="START^RAPRC",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("^TMP($J,""RAPRC"",")="",ZTSAVE("RAITNUM")="",ZTSAVE("RAITYPE")=""
|
|
DEV W ! D ZIS^RAUTL I RAPOP D Q^RAPRC1 Q
|
|
START ;start processing
|
|
U IO K ^TMP($J,"RA") S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999,RACRT=9 D CRIT^RAUTL1
|
|
S RALP=""
|
|
F S RALP=$O(^TMP($J,"RAPRC",RALP)) Q:RALP="" S ^TMP($J,"RA",RALP)="0^0^0"
|
|
K RALP
|
|
F RADTE=RABEG:0:RAEND S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND) F RADFN=0:0 S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0 D RADTI
|
|
G ^RAPRC1
|
|
;
|
|
RADTI F RADTI=0:0 K RAOR,RAPORT S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0 I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAD0=^(0) D RACNI
|
|
Q
|
|
RACNI S RADIV=$P($G(^RA(79,+$P(RAD0,U,3),0)),U),RADIV=$S($D(^DIC(4,+RADIV,0)):+RADIV,1:99) Q:'$D(^TMP($J,"RAPRC",RADIV))
|
|
F RACNI=0:0 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 I $D(^(RACNI,0)) S RAP0=^(0) D CHK:$D(RACRT(+$P(RAP0,"^",3)))
|
|
Q
|
|
;
|
|
CHK Q:$P($G(^RA(72,+$P(RAP0,U,3),0)),U,7)'=RAITNUM
|
|
S C=$S($D(^DIC(42,+$P(RAP0,"^",6),0)):"IN",1:"OUT")
|
|
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)
|
|
Q:'$D(^RAMIS(71,+$P(RAP0,"^",2),0)) S RAPRI=^(0),RAPRC=$E($P(RAPRI,"^"),1,30) Q:'$D(^(2)) F I=0:0 S I=$O(^RAMIS(71,+$P(RAP0,"^",2),2,I)) Q:I'>0 I $D(^(I,0)) S RAZ=^(0),RAMJ=$S($D(^RAMIS(71.1,+RAZ,0)):^(0),1:"") D PRC
|
|
Q:'$D(RAMIS(1)) F I=0:0 S I=$O(RAMIS(I)) Q:I'>0 S RAMIS=RAMIS(I),RAWT=RAWT(I),RAMUL=RAMUL(I) D STORE
|
|
K RAMIS,RAWT,RAMUL,RAZ,RAMJ,RAMULP,RAMULPFL Q
|
|
;
|
|
STORE I $D(RAOR) S RANUM=RAMUL,A=25 D AUX K RAFL
|
|
I $D(RAPORT) S RANUM=RAMUL,A=26 D AUX K RAFL
|
|
I $D(RAMULP) S RANUM=$S($D(RAMULPFL):0,1:1),A="MULP",RAMULPFL="" D AUX
|
|
S X=^TMP($J,"RA",RADIV),^(RADIV)=($S(C="IN":$P(X,"^")+($S(RAMUL:RAMUL,1:1)),1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+($S(RAMUL:RAMUL,1:1)),1:$P(X,"^",2)))_"^"_($P(X,"^",3)+(RAMUL*RAWT))
|
|
S:'$D(^TMP($J,"RA",RADIV,RAMIS)) ^(RAMIS)="0^0^0" S X=^(RAMIS),^(RAMIS)=($S(C="IN":$P(X,"^")+($S(RAMUL:RAMUL,1:1)),1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+($S(RAMUL:RAMUL,1:1)),1:$P(X,"^",2)))_"^"_($P(X,"^",3)+(RAMUL*RAWT))
|
|
S:'$D(^TMP($J,"RA",RADIV,RAMIS,RAPRC)) ^(RAPRC)="0^0^0" S X=^(RAPRC),^(RAPRC)=($S(C="IN":$P(X,"^")+($S(RAMUL:RAMUL,1:1)),1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+($S(RAMUL:RAMUL,1:1)),1:$P(X,"^",2)))_"^"_($P(X,"^",3)+(RAMUL*RAWT))
|
|
Q
|
|
;
|
|
PRC I +RAZ=25 S RAOR="" Q
|
|
I +RAZ=26 S RAPORT="" Q
|
|
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)'="":+$P(RAZ,U,2),1:1) S:$D(RABILAT)&(RAMUL(J)<2) RAMUL(J)=RAMUL(J)*2 S:J>1 RAMULP="" Q
|
|
K RABILAT
|
|
Q
|
|
;
|
|
AUX S:'$D(^TMP($J,"RA",RADIV,A)) ^(A)="0^0^0" S X=^(A),^(A)=($S(C="IN":$P(X,"^")+RANUM,1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+RANUM,1:$P(X,"^",2)))_"^"_($P(X,"^",3)+(RAMUL*RAWT))
|
|
S:'$D(^TMP($J,"RA",RADIV,A,RAPRC)) ^(RAPRC)="0^0^0" S X=^(RAPRC),^(RAPRC)=($S(C="IN":$P(X,"^")+RANUM,1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+RANUM,1:$P(X,"^",2)))_"^"_($P(X,"^",3)+(RAMUL*RAWT))
|
|
Q
|
|
IT ; select imaging type
|
|
D SETUP^RAUTL7A N RAIMGNUM
|
|
S X=$O(RACCESS(DUZ,"IMG",0)) I X'>0 S RAITYPE="" Q
|
|
S Y=+$O(RACCESS(DUZ,"IMG",X)) I Y'>0 S RAITNUM=X,RAITYPE=$P(^RA(79.2,X,0),U,1) S:RAITNUM]""&(RAITYPE]"") ^TMP($J,"RA I-TYPE",RAITYPE,RAITNUM)="" Q
|
|
S RAIMGNUM=$$IMGNUM^RAUTL7A() I RAIMGNUM=1 D SAVEONE^RAPRC1 Q
|
|
W ! K DIC S DIC="^RA(79.2,",DIC(0)="AEMQZ",DIC("A")="Select one IMAGING TYPE: ",DIC("S")="I $D(^TMP($J,""DIV-IMG"",+Y)),$D(RACCESS(DUZ,""IMG"",+Y))" D ^DIC
|
|
I Y'>0 S Y=""
|
|
S RAITNUM=+Y,RAITYPE=$P(Y,U,2)
|
|
K DIC,DTOUT,DUOUT
|
|
I RAITNUM]"",RAITYPE]"" S ^TMP($J,"RA I-TYPE",RAITYPE,RAITNUM)=""
|
|
Q
|