source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTUVR1.m@ 1154

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

revised back to 6/30/08 version
File size: 4.8 KB
RevLine 
[623]1RARTUVR1 ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:16
2 ;;5.0;Radiology/Nuclear Medicine;**29**;Mar 16, 1998
3 ;
4 ; RAHOURS=hours diffce btw DT and RARPTENT, also used in RACUT(rahours)
5BTG ; build tmp global
6 N RAQT
7 S RARE(0)=$G(^RADPT(RADFN,"DT",RADTI,0))
8 S RADIVNUM=+$P(RARE(0),U,3),RADIVNME=$P($G(^DIC(4,RADIVNUM,0)),U)
9 I RADIVNME]"",('$D(^TMP($J,"RA D-TYPE",RADIVNME))) Q
10 S RADIVNME=$S(RADIVNME]"":RADIVNME,1:"Unknown")
11 S RAITNUM=+$P(RARE(0),U,2),RAITNAME=$P($G(^RA(79.2,RAITNUM,0)),U)
12 I RAITNAME]"",('$D(^TMP($J,"RA I-TYPE",RAITNAME))) Q
13 S RAITNAME=$S(RAITNAME]"":RAITNAME,1:"Unknown")
14 K RARE(0)
15 Q:'$D(^TMP($J,"RAUVR",RADIVNME,RAITNAME))
16 S RAQT=0 ; RAQT set to 1 if this report has already been counted
17 I RAIP["R" D INC("R") Q:RAQT
18 I RAIP["S" D INC("S") Q:RAQT
19 I RAIP="U" D INC("U") Q:RAQT
20 S ^TMP($J,"RAUVR",RADIVNME,RAITNAME)=$G(^TMP($J,"RAUVR",RADIVNME,RAITNAME))+1
21 Q
22INC(RATYP) ; Increment count for Resident, Staff or Unknown
23 ;
24 N RA1
25 S RATYP=$E($G(RATYP))
26 S RAIPNAME=$P($G(^VA(200,$S(RATYP="R":RAPRES,RATYP="S":RAPSTF,1:U),0)),U,1)
27 S:RAIPNAME="" RAIPNAME="UNKNOWN"
28 ; If report on ASTAT x-ref for 2 report statuses, then it will be
29 ; counted twice. Check if dealt with already. If so, QUIT
30 I $D(^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,RARPT)) S RAQT=1 Q
31 S ^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,RARPT)=$G(RADFN)_U_$G(RADTI)_U_$G(RACNI)
32 S ^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME)=$G(^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME))+1
33 S RA1=$S(RATYP="R":"RESCNT",RATYP="S":"STFCNT",1:"UNKCNT")
34 S ^TMP($J,RADIVNME,RAITNAME,RA1)=$G(^TMP($J,RADIVNME,RAITNAME,RA1))+1
35 Q:'$D(RARPTENT)
36 S RAHOURS=$$FMDIFF^XLFDT(DT,RARPTENT,2)/3600
37 S RAHOURS=$S(RAHOURS<RACUT(1):1,RAHOURS<RACUT(2):2,RAHOURS<RACUT(3):3,1:4)
38 S ^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,"H",RAHOURS)=$G(^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,"H",RAHOURS))+1
39 S ^TMP($J,RADIVNME,RAITNAME,"H",RAHOURS,RARPT)=$G(^TMP($J,RADIVNME,RAITNAME,"H",RAHOURS,RARPT))+1
40 Q
41 ;
42PHYS ;print other staff and residents
43 N RA2ND,R1,R2,RASTR
44 S (R1,R2)=0 F S R2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",R2)) Q:'R2 S:+$G(^(R2,0)) R1=R1+1,RA2ND("SRR",R1)=+^(0),RA2ND("SRR",R1)=$E($P($G(^VA(200,RA2ND("SRR",R1),0)),"^"),1,20)
45 S (R1,R2)=0 F S R2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",R2)) Q:'R2 S:+$G(^(R2,0)) R1=R1+1,RA2ND("SSR",R1)=+^(0),RA2ND("SSR",R1)=$E($P($G(^VA(200,RA2ND("SSR",R1),0)),"^"),1,20)
46 S R1=$E($P($G(^VA(200,+$P(Y(0),"^",15),0)),"^"),1,15) ; prim staff
47 S RASTR="Other Att/Res: "
48 S:RAIPNAME'[R1 RASTR=RASTR_R1
49PHYS1 I '$O(RA2ND("SSR",0)) G PHYS2
50 S R1=0
51PHYS11 S R1=$O(RA2ND("SSR",R1)) G:R1="" PHYS2
52 G:RAIPNAME[RA2ND("SSR",R1) PHYS11 ;omit if name matches current staff/resid/unkn
53 I $L(RASTR)+$L(RA2ND("SSR",R1))>IOM W !,RASTR,"; " S RASTR=" "
54 S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_RA2ND("SSR",R1) G PHYS11
55PHYS2 S R1=$E($P($G(^VA(200,+$P(Y(0),"^",12),0)),"^"),1,15) ;prim resid
56 I RAIPNAME[R1 G PHYS20 ;omit if name matches current staff/resid/unk
57 I $L(RASTR)+$L(R1)>IOM W !,RASTR,"; " S RASTR=" "
58 S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_R1
59PHYS20 I '$O(RA2ND("SRR",0)) W !,RASTR Q
60 S R1=0
61PHYS21 S R1=$O(RA2ND("SRR",R1)) G:R1="" PHYS29
62 G:RAIPNAME[RA2ND("SRR",R1) PHYS21 ;omit if name matches current staff/resident/unkn
63 I $L(RASTR)+$L(RA2ND("SRR",R1))>IOM W !,RASTR,"; " S RASTR=" "
64 S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_RA2ND("SRR",R1) G PHYS21
65PHYS29 W:RASTR]" " !,RASTR
66 Q
67DIVSUM ;division summary -- skip if only one imaging type chosen for this div
68 Q:$O(^TMP($J,"RAUVR",RADIVNME,0))=$O(^TMP($J,"RAUVR",RADIVNME,""),-1)
69 N RA2ND ;reuse this local array
70 I RACNT(0)'<RACNT S RAOUT=$$EOS^RAUTL5() Q:RAOUT ;before last screen
71 W:$Y>0 @IOF W !?$S(IOM<81:20,1:IOM-90),">>>>> Unverified Reports (",$S(RABD="B":"brief",1:"detailed"),") <<<<<" S RAPAGE=RAPAGE+1 W ?$S(IOM<81:70,1:IOM-10),"Page: ",RAPAGE
72 W !,"Division: ",?10,RADIVNME,?$S(IOM<81:43,1:IOM-37),"Report Date Range:",?$S(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(BEGDATE),!?$S(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(ENDDATE)
73 W !,"Imaging Type(s): "
74 S RA1="" F S RA1=$O(^TMP($J,"RAUVR",RADIVNME,RA1)) Q:RA1="" W:($L(RA1)+3+$X)>IOM !?17 W RA1," "
75 W !!,"Run Date: ",RARUNDAT
76 W !!!?26,"Division Summary",!?26,$E(RADASH,1,16)
77 D HOURAGE^RARTUVR2
78 S RA1=0 F S RA1=$O(^TMP($J,RADIVNME,RA1)) Q:RA1="" D
79 .S RA2="" F S RA2=$O(^TMP($J,RADIVNME,RA1,"H",RA2)) Q:RA2="" D
80 ..S RA3="" F S RA3=$O(^TMP($J,RADIVNME,RA1,"H",RA2,RA3)) Q:RA3="" D
81 ...S RA2ND(RA2)=$G(RA2ND(RA2))+1
82 W !!,"Total Unverified Reports: "
83 W ?29,$S($G(RA2ND(1)):$J(RA2ND(1),$L(RACUT(3))),1:$J(0,$L(RACUT(3)))),?39,$S($G(RA2ND(2)):$J(RA2ND(2),$L(RACUT(3))),1:$J(0,$L(RACUT(3))))
84 W ?49,$S($G(RA2ND(3)):$J(RA2ND(3),$L(RACUT(3))),1:$J(0,$L(RACUT(3)))),?59,$S($G(RA2ND(4)):$J(RA2ND(4),$L(RACUT(3))+2),1:$J(0,$L(RACUT(3))+2))
85 S RA1=0 F RA4=1:1:4 S RA1=RA1+$G(RA2ND(RA4))
86 W !!,"Division Total: ",RA1,!!
87 S RAOUT=$$EOS^RAUTL5()
Note: See TracBrowser for help on using the repository browser.