source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWKL1.m@ 841

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1RAWKL1 ;HISC/FPT-Workload Reports (cont.) ;12/27/00 11:28
2 ;;5.0;Radiology/Nuclear Medicine;**26,31**;Mar 16, 1998
3RADFN ; count & store in tmp global
4 S RADFN=0 F K RAOR,RAPORT S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0!($D(RAEOS)) I $D(^RADPT(RADFN,"DT",RADTI,0)) S RAD0=^(0) D RACNI
5 Q
6RACNI ;
7 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)) S RACNI=0
9 ;RAPRIM=0 means want both primary and secondary staff/resid
10 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!($D(RAEOS)) I $D(^(RACNI,0)) S RAP0=^(0),RAPIFN=+$P(RAP0,"^",2) I $D(RACRT(+$P(RAP0,U,3))) D ITNAME I RAITYPE?3AP1"-".N D
11 . D CHK:RAPCE,TC:'RAPCE
12 . D:RAPCE=12&($G(RAPRIM)=0) SECRES
13 . D:RAPCE=15&($G(RAPRIM)=0) SECSTF
14 . Q
15 Q
16CHK ;
17 Q:'$D(^TMP($J,"RA",RADIV,RAITYPE))
18 K RAFLD("DESC")
19 S:RAPCE RAFLD=$S($D(@("^"_RAFILE_"+$P(RAP0,""^"",RAPCE),0)")):$P(^(0),"^"),1:"UNKNOWN") I RAPCE=18,$D(^(0)) S RAFLD("DESC")=" - "_$P(^(0),"^",2)
20 I RAINPUT=0,'$D(^TMP($J,"RAFLD",RAFLD)) Q
21 I $D(RAFLD("DESC")) S RAFLD=RAFLD_RAFLD("DESC") K RAFLD("DESC")
22 S RAFLD=$E(RAFLD,1,30)
23 S C=$S($D(^DIC(42,+$P(RAP0,"^",6),0)):"IN",1:"OUT")
24 ; for each proc mod, check for Amis Credit Indicator, file 71.2:
25 ; where "b"=bilateral, "o"=operating room, "p"=portable
26 S I=0 F 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)
27 Q:'$D(^RAMIS(71,RAPIFN,0)) S RAPRI=^(0)
28 ;raz=^ramis(71,rapifn,2,i,0)
29 ;ramj=^ramis(71.1,+raz,0)
30 S RAPRC=$$LJ^XLFSTR($E($P(RAPRI,"^"),1,27),29," ") D CPT^RAFLM D CMLIST(.RAPRC) Q:'$D(^RAMIS(71,RAPIFN,2)) S I=0 F 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
31 Q:'$D(RAMIS(1))
32 I J=1 S RAMIS=RAMIS(1),RAWT=RAWT(1),RAMUL=RAMUL(1),RAWT=RAWT*RAMUL,RANUM=RAMUL
33 I J>1 S RANUM=1,RAWT=0,RAMIS=RAMIS(1) F J=1:1 Q:'$D(RAMIS(J)) S I=RAWT(J),RAMUL=RAMUL(J),RAWT=RAWT+(RAMUL*I)
34 D STORE K RAMIS,RAWT,RAMUL,RAZ,RAMJ,RAMULP,RAMULPFL,RAOR,RAPORT
35 Q
36 ;
37STORE ; Store off into ^TMP($J,"RA"
38 I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAEOS="" Q:$D(RAEOS)
39 ; presence of:
40 ; RAOR = operating room, set from extra^rautl12(-) and/or PRC
41 ; RAPORT = portable, set from extra^rautl12(-) and/or PRC
42 ; RAMULP = proc has >1 Amis Codes
43 I $D(RAOR) S A=25 D AUX
44 I $D(RAPORT) S A=26 D AUX
45 I $D(RAMULP) S A="MULP" D AUX
46 S X=^TMP($J,"RA",RADIV),^(RADIV)=($S(C="IN":$P(X,"^")+RANUM,1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+RANUM,1:$P(X,"^",2)))_"^"_($P(X,"^",3)+RAWT)
47 S X=^TMP($J,"RA",RADIV,RAITYPE),^(RAITYPE)=($S(C="IN":$P(X,"^")+RANUM,1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+RANUM,1:$P(X,"^",2)))_"^"_($P(X,"^",3)+RAWT)
48 S:'($D(^TMP($J,"RA",RADIV,RAITYPE,RAFLD))#2) ^(RAFLD)="0^0^0" S X=^(RAFLD),^(RAFLD)=($S(C="IN":$P(X,"^")+RANUM,1:$P(X,"^")))_"^"_($S(C="OUT":$P(X,"^",2)+RANUM,1:$P(X,"^",2)))_"^"_($P(X,"^",3)+RAWT)
49 S:'$D(^TMP($J,"RA",RADIV,RAITYPE,RAFLD,RAMIS,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)+RAWT)
50 Q
51 ; this PRC is done for each Proc's Amis Code sub record
52 ; 1st sub rec would be RAMIS(1), 2nd would be RAMIS(2), etc.
53 ; ramis(j)=ien 71.1
54 ; rawt(j)=record 71.1's WEIGHT
55 ; ramul(j)=file 71'S Amis code sub rec's Amis Weight Multiplier
56 ;
57PRC I +RAZ=25 S RAOR="" Q
58 I +RAZ=26 S RAPORT="" Q
59 S:$P(RAZ,"^",3)="Y" RABILAT="" F J=1:1 I '$D(RAMIS(J)) S RAMIS(J)=$S(RAMJ]"":+RAZ,1:99),RAWT(J)=+$P(RAMJ,"^",2),RAMUL(J)=$S(+$P(RAZ,"^",2)>0:+$P(RAZ,U,2),1:1) S:$D(RABILAT)&(RAMUL(J)<2) RAMUL(J)=RAMUL(J)*2 S:J>1 RAMULP="" Q
60 K RABILAT
61 Q
62 ;
63AUX S:'$D(^TMP($J,"RA",RADIV,RAITYPE,RAFLD,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)+RAWT)
64 Q
65 ;
66TC S RATCI=0 F S RATCI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RATCI)) Q:RATCI'>0 S RAFLD=$S($D(^VA(200,+^(RATCI,0),0)):$P(^(0),"^"),1:"") D:RAFLD]"" CHK
67 Q
68SECRES ; count secondary residents
69 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",0))
70 S RASRR=0,RAPCE(1)=RAPCE,RAPCE="SRR"
71 F S RASRR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",RASRR)) Q:RASRR'>0 S RAFLD=$S($D(^VA(200,+^(RASRR,0),0)):$P(^(0),"^",1),1:"") D:RAFLD]"" CHK
72 K RASRR S RAPCE=RAPCE(1)
73 Q
74SECSTF ; count secondary staff
75 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",0))
76 S RASSR=0,RAPCE(1)=RAPCE,RAPCE="SSR"
77 F S RASSR=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",RASSR)) Q:RASSR'>0 S RAFLD=$S($D(^VA(200,+^(RASSR,0),0)):$P(^(0),"^",1),1:"") D:RAFLD]"" CHK
78 K RASSR S RAPCE=RAPCE(1)
79 Q
80 ;
81ITNAME ; get imaging type name from Exam's exam status
82 S RAITNUM=$P($G(^RA(72,+$P(RAP0,U,3),0)),U,7)
83 S RAITYPE=$E($P($G(^RA(79.2,+RAITNUM,0)),U,1),1,3)_"-"_+RAITNUM
84 K RAITNUM
85 Q
86CMLIST(RASTR) ;append max 3 CPTmods onto string and within any ()
87 Q:'$G(RACMLIST) ;user doesn't want CPT mods as separate line items
88 Q:'$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0))
89 N RACMSTR,I,J,X
90 S I=0 ;put into array to let M sort external values of CPT Mods
91 F S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",I)) Q:I'>0 S X=$$BASICMOD^RACPTMSC(+$G(^(I,0)),DT),RACMSTR($P(X,U,2))=""
92 S I="",J=0
93 F S I=$O(RACMSTR(I)) Q:I="" S J=J+1 Q:J>3 S RACMSTR=$G(RACMSTR)_$S($G(RACMSTR)="":"",1:",")_I
94 S:J>3 RACMSTR=RACMSTR_"*"
95 S:RASTR["(" RASTR=$E(RASTR,1,($L(RASTR)-1)) ;remove ")"
96 S RASTR=RASTR_"-"_RACMSTR_$S(RASTR["(":")",1:"") ;append CPTmods to str
97 Q
Note: See TracBrowser for help on using the repository browser.