- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTUVR1.m
r613 r623 1 RARTUVR1 ;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) 6 BTG ; 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 23 INC(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 ; 44 PHYS ;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 51 PHYS1 I '$O(RA2ND("SSR",0)) G PHYS2 52 S R1=0 53 PHYS11 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 57 PHYS2 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 61 PHYS20 I '$O(RA2ND("SRR",0)) W !,RASTR Q 62 S R1=0 63 PHYS21 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 67 PHYS29 W:RASTR]" " !,RASTR 68 Q 69 DIVSUM ;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() 1 RARTUVR1 ;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) 5 BTG ; 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 22 INC(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 ; 42 PHYS ;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 49 PHYS1 I '$O(RA2ND("SSR",0)) G PHYS2 50 S R1=0 51 PHYS11 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 55 PHYS2 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 59 PHYS20 I '$O(RA2ND("SRR",0)) W !,RASTR Q 60 S R1=0 61 PHYS21 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 65 PHYS29 W:RASTR]" " !,RASTR 66 Q 67 DIVSUM ;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 TracChangeset
for help on using the changeset viewer.
