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

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

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