| 1 | RAFLM1 ;HISC/GJC-Radiology Film Usage Report ;4/22/97 12:22
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**10**;Mar 16, 1998
|
|---|
| 3 | ; count & store in tmp global
|
|---|
| 4 | RADTI ;
|
|---|
| 5 | F RADTI=0:0 S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0 I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAD0=^(0) D RACNI Q:RAEOS
|
|---|
| 6 | Q
|
|---|
| 7 | RACNI S RADIV=$P($G(^RA(79,+$P(RAD0,U,3),0)),U),RADIV=$S($D(^DIC(4,+RADIV,0)):+RADIV,1:99)
|
|---|
| 8 | Q:'$D(^TMP($J,"RA",RADIV))
|
|---|
| 9 | F RACNI=0:0 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 I $D(^(RACNI,0)) S RAP0=^(0),RAPIFN=+$P(RAP0,"^",2) I $D(RACRT(+$P(RAP0,"^",3))) D ITNAME^RAWKL1 I RAITYPE?3AP1"-".N D CHK Q:RAEOS
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | CHK Q:'$D(^TMP($J,"RA",RADIV,RAITYPE))
|
|---|
| 13 | 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)
|
|---|
| 14 | Q:'$D(^RAMIS(71,RAPIFN,0)) S RAPRI=^(0),RAPRC=$$LJ^XLFSTR($E($P(RAPRI,"^"),1,27),29," ") D CPT^RAFLM Q:'$D(^RAMIS(71,RAPIFN,2))
|
|---|
| 15 | F I=0:0 S I=$O(^RAMIS(71,RAPIFN,2,I)) Q:I'>0 I $D(^(I,0)) S RAZ=^(0),RAMJ=$S($D(^RAMIS(71.1,+RAZ,0)):^(0),1:"") D PRC
|
|---|
| 16 | Q:'$D(RAMIS(1)) S RAMUL=$S(J=1:RAMUL(1),1:1),RAMIS=RAMIS(1)
|
|---|
| 17 | FLM F I=0:0 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"F",I)) Q:I'>0 D Q:RAEOS
|
|---|
| 18 | . Q:$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"F",I,0))']""
|
|---|
| 19 | . S RANUM=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"F",I,0))
|
|---|
| 20 | . Q:$D(^RA(78.4,"AW",1,+RANUM)) ;Quit if a wasted piece of film
|
|---|
| 21 | . S RAFLM=$S($D(^RA(78.4,+RANUM,0)):^(0),1:"UNKNOWN")
|
|---|
| 22 | . S:$P(RAFLM,U,2)="Y" RACINE=""
|
|---|
| 23 | . S RANUM=+$P(RANUM,U,2),RAFLM=$P(RAFLM,U)
|
|---|
| 24 | . I RAINPUT=0,'$D(^TMP($J,"RAFILM",RAFLM)) K RACINE Q
|
|---|
| 25 | . D:RANUM STORE
|
|---|
| 26 | . K RACINE
|
|---|
| 27 | . Q
|
|---|
| 28 | K RAMIS,RAMUL,RAZ,RAMJ,RAMULP,RAMULPFL
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | STORE ; Store the data into ^TMP($J,"RA", by division )
|
|---|
| 32 | I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS=1 Q:RAEOS
|
|---|
| 33 | I $D(RAOR) S A=25 D AUX ;If operating room
|
|---|
| 34 | I $D(RAPORT) S A=26 D AUX ;If portable
|
|---|
| 35 | I $D(RAMULP) S A="MULP" D AUX ;If modifier
|
|---|
| 36 | S:'$D(^TMP($J,"RA",RADIV,RAITYPE,RAFLM,RAMIS,RAPRC)) ^(RAPRC)="0^0^"_$S($P(RAPRI,"^",6)="S":"*",1:"") S X=^(RAPRC),$P(^(RAPRC),"^",1,2)=($P(X,"^")+RAMUL)_"^"_($P(X,"^",2)+RANUM)
|
|---|
| 37 | I '$D(RACINE) S X=^TMP($J,"RA",RADIV),$P(^(RADIV),"^",1,2)=($P(X,"^")+RAMUL)_"^"_($P(X,"^",2)+RANUM)
|
|---|
| 38 | I '$D(RACINE) S X=^TMP($J,"RA",RADIV,RAITYPE),$P(^(RAITYPE),"^",1,2)=($P(X,"^")+RAMUL)_"^"_($P(X,"^",2)+RANUM)
|
|---|
| 39 | S:'($D(^TMP($J,"RA",RADIV,RAITYPE,RAFLM))#2) ^(RAFLM)="0^0^^"_$S($D(RACINE):1,1:"") S X=^(RAFLM),$P(^(RAFLM),"^",1,2)=($P(X,"^")+RAMUL)_"^"_($P(X,"^",2)+RANUM)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | PRC I +RAZ=25 S RAOR="" Q
|
|---|
| 43 | I +RAZ=26 S RAPORT="" Q
|
|---|
| 44 | S:$P(RAZ,"^",3)="Y" RABILAT="" F J=1:1 I '$D(RAMIS(J)) S RAMIS(J)=$S(RAMJ]"":+RAZ,1:99),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
|
|---|
| 45 | K RABILAT
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | AUX S:'$D(^TMP($J,"RA",RADIV,RAITYPE,RAFLM,A,RAPRC)) ^(RAPRC)="0^0^"_$S($P(RAPRI,"^",6)="S":"*",1:"")
|
|---|
| 49 | S X=^TMP($J,"RA",RADIV,RAITYPE,RAFLM,A,RAPRC),^(RAPRC)=($P(X,"^")+RAMUL)_"^"_($P(X,"^",2)+RANUM)_"^"_$P(X,"^",3)
|
|---|
| 50 | Q
|
|---|
| 51 | CPT Q:'$P(RAPRI,"^",9) S RACPT=+$P(RAPRI,"^",9)
|
|---|
| 52 | S RACPT=$$NAMCODE^RACPTMSC(RACPT,DT),RACPT=$P(RACPT,"^")
|
|---|
| 53 | Q:RACPT=""
|
|---|
| 54 | S RAPRC=RAPRC_"("_RACPT_")"
|
|---|
| 55 | Q
|
|---|
