RARTUVR1 ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:16
;;5.0;Radiology/Nuclear Medicine;**29,56**;Mar 16, 1998;Build 3
;
;Supported IA #2056 GET1^DIQ
; RAHOURS=hours diffce btw DT and RARPTENT, also used in RACUT(rahours)
BTG ; build tmp global
N RAQT
S RARE(0)=$G(^RADPT(RADFN,"DT",RADTI,0))
S RADIVNUM=+$P(RARE(0),U,3),RADIVNME=$P($G(^DIC(4,RADIVNUM,0)),U)
I RADIVNME]"",('$D(^TMP($J,"RA D-TYPE",RADIVNME))) Q
S RADIVNME=$S(RADIVNME]"":RADIVNME,1:"Unknown")
S RAITNUM=+$P(RARE(0),U,2),RAITNAME=$P($G(^RA(79.2,RAITNUM,0)),U)
I RAITNAME]"",('$D(^TMP($J,"RA I-TYPE",RAITNAME))) Q
S RAITNAME=$S(RAITNAME]"":RAITNAME,1:"Unknown")
K RARE(0)
Q:'$D(^TMP($J,"RAUVR",RADIVNME,RAITNAME))
S RAQT=0 ; RAQT set to 1 if this report has already been counted
I RAIP["R" D INC("R") Q:RAQT
I RAIP["S" D INC("S") Q:RAQT
I RAIP="U" D INC("U") Q:RAQT
S ^TMP($J,"RAUVR",RADIVNME,RAITNAME)=$G(^TMP($J,"RAUVR",RADIVNME,RAITNAME))+1
Q
INC(RATYP) ; Increment count for Resident, Staff or Unknown
;
N RA1
S RATYP=$E($G(RATYP))
S RAIPNAME=$S(RATYP="R":RAPRES,RATYP="S":RAPSTF,1:"")
S:RAIPNAME'="" RAIPNAME=$$GET1^DIQ(200,RAIPNAME_",",.01)
S:RAIPNAME="" RAIPNAME="UNKNOWN"
; If report on ASTAT x-ref for 2 report statuses, then it will be
; counted twice. Check if dealt with already. If so, QUIT
I $D(^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,RARPT)) S RAQT=1 Q
S ^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,RARPT)=$G(RADFN)_U_$G(RADTI)_U_$G(RACNI)
S ^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME)=$G(^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME))+1
S RA1=$S(RATYP="R":"RESCNT",RATYP="S":"STFCNT",1:"UNKCNT")
S ^TMP($J,RADIVNME,RAITNAME,RA1)=$G(^TMP($J,RADIVNME,RAITNAME,RA1))+1
Q:'$D(RARPTENT)
S RAHOURS=$$FMDIFF^XLFDT(DT,RARPTENT,2)/3600
S RAHOURS=$S(RAHOURS<RACUT(1):1,RAHOURS<RACUT(2):2,RAHOURS<RACUT(3):3,1:4)
S ^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,"H",RAHOURS)=$G(^TMP($J,RADIVNME,RAITNAME,RATYP,RAIPNAME,"H",RAHOURS))+1
S ^TMP($J,RADIVNME,RAITNAME,"H",RAHOURS,RARPT)=$G(^TMP($J,RADIVNME,RAITNAME,"H",RAHOURS,RARPT))+1
Q
;
PHYS ;print other staff and residents
N RA2ND,R1,R2,RASTR
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)
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)
S R1=$E($$GET1^DIQ(200,+$P(Y(0),"^",15)_",",.01),1,15) ; prim staff
S RASTR="Other Att/Res: "
S:RAIPNAME'[R1 RASTR=RASTR_R1
PHYS1 I '$O(RA2ND("SSR",0)) G PHYS2
S R1=0
PHYS11 S R1=$O(RA2ND("SSR",R1)) G:R1="" PHYS2
G:RAIPNAME[RA2ND("SSR",R1) PHYS11 ;omit if name matches current staff/resid/unkn
I $L(RASTR)+$L(RA2ND("SSR",R1))>IOM W !,RASTR,"; " S RASTR=" "
S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_RA2ND("SSR",R1) G PHYS11
PHYS2 S R1=$E($$GET1^DIQ(200,+$P(Y(0),"^",12)_",",.01),1,15) ;prim resid
I RAIPNAME[R1 G PHYS20 ;omit if name matches current staff/resid/unk
I $L(RASTR)+$L(R1)>IOM W !,RASTR,"; " S RASTR=" "
S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_R1
PHYS20 I '$O(RA2ND("SRR",0)) W !,RASTR Q
S R1=0
PHYS21 S R1=$O(RA2ND("SRR",R1)) G:R1="" PHYS29
G:RAIPNAME[RA2ND("SRR",R1) PHYS21 ;omit if name matches current staff/resident/unkn
I $L(RASTR)+$L(RA2ND("SRR",R1))>IOM W !,RASTR,"; " S RASTR=" "
S:RASTR]" " RASTR=RASTR_"; " S RASTR=RASTR_RA2ND("SRR",R1) G PHYS21
PHYS29 W:RASTR]" " !,RASTR
Q
DIVSUM ;division summary -- skip if only one imaging type chosen for this div
Q:$O(^TMP($J,"RAUVR",RADIVNME,0))=$O(^TMP($J,"RAUVR",RADIVNME,""),-1)
N RA2ND ;reuse this local array
I RACNT(0)'<RACNT S RAOUT=$$EOS^RAUTL5() Q:RAOUT ;before last screen
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
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)
W !,"Imaging Type(s): "
S RA1="" F S RA1=$O(^TMP($J,"RAUVR",RADIVNME,RA1)) Q:RA1="" W:($L(RA1)+3+$X)>IOM !?17 W RA1," "
W !!,"Run Date: ",RARUNDAT
W !!!?26,"Division Summary",!?26,$E(RADASH,1,16)
D HOURAGE^RARTUVR2
S RA1=0 F S RA1=$O(^TMP($J,RADIVNME,RA1)) Q:RA1="" D
.S RA2="" F S RA2=$O(^TMP($J,RADIVNME,RA1,"H",RA2)) Q:RA2="" D
..S RA3="" F S RA3=$O(^TMP($J,RADIVNME,RA1,"H",RA2,RA3)) Q:RA3="" D
...S RA2ND(RA2)=$G(RA2ND(RA2))+1
W !!,"Total Unverified Reports: "
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))))
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))
S RA1=0 F RA4=1:1:4 S RA1=RA1+$G(RA2ND(RA4))
W !!,"Division Total: ",RA1,!!
S RAOUT=$$EOS^RAUTL5()
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTUVR1 5062 printed Apr 09, 2024@21:37:58 Page 2
RARTUVR1 ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:16
+1 ;;5.0;Radiology/Nuclear Medicine;**29,56**;Mar 16, 1998;Build 3
+2 ;
+3 ;Supported IA #2056 GET1^DIQ
+4 ; RAHOURS=hours diffce btw DT and RARPTENT, also used in RACUT(rahours)
BTG ; build tmp global
+1 NEW RAQT
+2 SET RARE(0)=$GET(^RADPT(RADFN,"DT",RADTI,0))
+3 SET RADIVNUM=+$PIECE(RARE(0),U,3)
SET RADIVNME=$PIECE($GET(^DIC(4,RADIVNUM,0)),U)
+4 IF RADIVNME]""
IF ('$DATA(^TMP($JOB,"RA D-TYPE",RADIVNME)))
QUIT
+5 SET RADIVNME=$SELECT(RADIVNME]"":RADIVNME,1:"Unknown")
+6 SET RAITNUM=+$PIECE(RARE(0),U,2)
SET RAITNAME=$PIECE($GET(^RA(79.2,RAITNUM,0)),U)
+7 IF RAITNAME]""
IF ('$DATA(^TMP($JOB,"RA I-TYPE",RAITNAME)))
QUIT
+8 SET RAITNAME=$SELECT(RAITNAME]"":RAITNAME,1:"Unknown")
+9 KILL RARE(0)
+10 if '$DATA(^TMP($JOB,"RAUVR",RADIVNME,RAITNAME))
QUIT
+11 ; RAQT set to 1 if this report has already been counted
SET RAQT=0
+12 IF RAIP["R"
DO INC("R")
if RAQT
QUIT
+13 IF RAIP["S"
DO INC("S")
if RAQT
QUIT
+14 IF RAIP="U"
DO INC("U")
if RAQT
QUIT
+15 SET ^TMP($JOB,"RAUVR",RADIVNME,RAITNAME)=$GET(^TMP($JOB,"RAUVR",RADIVNME,RAITNAME))+1
+16 QUIT
INC(RATYP) ; Increment count for Resident, Staff or Unknown
+1 ;
+2 NEW RA1
+3 SET RATYP=$EXTRACT($GET(RATYP))
+4 SET RAIPNAME=$SELECT(RATYP="R":RAPRES,RATYP="S":RAPSTF,1:"")
+5 if RAIPNAME'=""
SET RAIPNAME=$$GET1^DIQ(200,RAIPNAME_",",.01)
+6 if RAIPNAME=""
SET RAIPNAME="UNKNOWN"
+7 ; If report on ASTAT x-ref for 2 report statuses, then it will be
+8 ; counted twice. Check if dealt with already. If so, QUIT
+9 IF $DATA(^TMP($JOB,RADIVNME,RAITNAME,RATYP,RAIPNAME,RARPT))
SET RAQT=1
QUIT
+10 SET ^TMP($JOB,RADIVNME,RAITNAME,RATYP,RAIPNAME,RARPT)=$GET(RADFN)_U_$GET(RADTI)_U_$GET(RACNI)
+11 SET ^TMP($JOB,RADIVNME,RAITNAME,RATYP,RAIPNAME)=$GET(^TMP($JOB,RADIVNME,RAITNAME,RATYP,RAIPNAME))+1
+12 SET RA1=$SELECT(RATYP="R":"RESCNT",RATYP="S":"STFCNT",1:"UNKCNT")
+13 SET ^TMP($JOB,RADIVNME,RAITNAME,RA1)=$GET(^TMP($JOB,RADIVNME,RAITNAME,RA1))+1
+14 if '$DATA(RARPTENT)
QUIT
+15 SET RAHOURS=$$FMDIFF^XLFDT(DT,RARPTENT,2)/3600
+16 SET RAHOURS=$SELECT(RAHOURS<RACUT(1):1,RAHOURS<RACUT(2):2,RAHOURS<RACUT(3):3,1:4)
+17 SET ^TMP($JOB,RADIVNME,RAITNAME,RATYP,RAIPNAME,"H",RAHOURS)=$GET(^TMP($JOB,RADIVNME,RAITNAME,RATYP,RAIPNAME,"H",RAHOURS))+1
+18 SET ^TMP($JOB,RADIVNME,RAITNAME,"H",RAHOURS,RARPT)=$GET(^TMP($JOB,RADIVNME,RAITNAME,"H",RAHOURS,RARPT))+1
+19 QUIT
+20 ;
PHYS ;print other staff and residents
+1 NEW RA2ND,R1,R2,RASTR
+2 SET (R1,R2)=0
FOR
SET R2=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SRR",R2))
if 'R2
QUIT
if +$GET(^(R2,0))
SET R1=R1+1
SET RA2ND("SRR",R1)=+^(0)
SET RA2ND("SRR",R1)=$EXTRACT($$GET1^DIQ(200,RA2ND("SRR",R1)_",",.01),1,20)
+3 SET (R1,R2)=0
FOR
SET R2=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"SSR",R2))
if 'R2
QUIT
if +$GET(^(R2,0))
SET R1=R1+1
SET RA2ND("SSR",R1)=+^(0)
SET RA2ND("SSR",R1)=$EXTRACT($$GET1^DIQ(200,RA2ND("SSR",R1)_",",.01),1,20)
+4 ; prim staff
SET R1=$EXTRACT($$GET1^DIQ(200,+$PIECE(Y(0),"^",15)_",",.01),1,15)
+5 SET RASTR="Other Att/Res: "
+6 if RAIPNAME'[R1
SET RASTR=RASTR_R1
PHYS1 IF '$ORDER(RA2ND("SSR",0))
GOTO PHYS2
+1 SET R1=0
PHYS11 SET R1=$ORDER(RA2ND("SSR",R1))
if R1=""
GOTO PHYS2
+1 ;omit if name matches current staff/resid/unkn
if RAIPNAME[RA2ND("SSR",R1)
GOTO PHYS11
+2 IF $LENGTH(RASTR)+$LENGTH(RA2ND("SSR",R1))>IOM
WRITE !,RASTR,"; "
SET RASTR=" "
+3 if RASTR]" "
SET RASTR=RASTR_"; "
SET RASTR=RASTR_RA2ND("SSR",R1)
GOTO PHYS11
PHYS2 ;prim resid
SET R1=$EXTRACT($$GET1^DIQ(200,+$PIECE(Y(0),"^",12)_",",.01),1,15)
+1 ;omit if name matches current staff/resid/unk
IF RAIPNAME[R1
GOTO PHYS20
+2 IF $LENGTH(RASTR)+$LENGTH(R1)>IOM
WRITE !,RASTR,"; "
SET RASTR=" "
+3 if RASTR]" "
SET RASTR=RASTR_"; "
SET RASTR=RASTR_R1
PHYS20 IF '$ORDER(RA2ND("SRR",0))
WRITE !,RASTR
QUIT
+1 SET R1=0
PHYS21 SET R1=$ORDER(RA2ND("SRR",R1))
if R1=""
GOTO PHYS29
+1 ;omit if name matches current staff/resident/unkn
if RAIPNAME[RA2ND("SRR",R1)
GOTO PHYS21
+2 IF $LENGTH(RASTR)+$LENGTH(RA2ND("SRR",R1))>IOM
WRITE !,RASTR,"; "
SET RASTR=" "
+3 if RASTR]" "
SET RASTR=RASTR_"; "
SET RASTR=RASTR_RA2ND("SRR",R1)
GOTO PHYS21
PHYS29 if RASTR]" "
WRITE !,RASTR
+1 QUIT
DIVSUM ;division summary -- skip if only one imaging type chosen for this div
+1 if $ORDER(^TMP($JOB,"RAUVR",RADIVNME,0))=$ORDER(^TMP($JOB,"RAUVR",RADIVNME,""),-1)
QUIT
+2 ;reuse this local array
NEW RA2ND
+3 ;before last screen
IF RACNT(0)'<RACNT
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
+4 if $Y>0
WRITE @IOF
WRITE !?$SELECT(IOM<81:20,1:IOM-90),">>>>> Unverified Reports (",$SELECT(RABD="B":"brief",1:"detailed"),") <<<<<"
SET RAPAGE=RAPAGE+1
WRITE ?$SELECT(IOM<81:70,1:IOM-10),"Page: ",RAPAGE
+5 WRITE !,"Division: ",?10,RADIVNME,?$SELECT(IOM<81:43,1:IOM-37),"Report Date Range:",?$SELECT(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(BEGDATE),!?$SELECT(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(ENDDATE)
+6 WRITE !,"Imaging Type(s): "
+7 SET RA1=""
FOR
SET RA1=$ORDER(^TMP($JOB,"RAUVR",RADIVNME,RA1))
if RA1=""
QUIT
if ($LENGTH(RA1)+3+$X)>IOM
WRITE !?17
WRITE RA1," "
+8 WRITE !!,"Run Date: ",RARUNDAT
+9 WRITE !!!?26,"Division Summary",!?26,$EXTRACT(RADASH,1,16)
+10 DO HOURAGE^RARTUVR2
+11 SET RA1=0
FOR
SET RA1=$ORDER(^TMP($JOB,RADIVNME,RA1))
if RA1=""
QUIT
Begin DoDot:1
+12 SET RA2=""
FOR
SET RA2=$ORDER(^TMP($JOB,RADIVNME,RA1,"H",RA2))
if RA2=""
QUIT
Begin DoDot:2
+13 SET RA3=""
FOR
SET RA3=$ORDER(^TMP($JOB,RADIVNME,RA1,"H",RA2,RA3))
if RA3=""
QUIT
Begin DoDot:3
+14 SET RA2ND(RA2)=$GET(RA2ND(RA2))+1
End DoDot:3
End DoDot:2
End DoDot:1
+15 WRITE !!,"Total Unverified Reports: "
+16 WRITE ?29,$SELECT($GET(RA2ND(1)):$JUSTIFY(RA2ND(1),$LENGTH(RACUT(3))),1:$JUSTIFY(0,$LENGTH(RACUT(3)))),?39,$SELECT($GET(RA2ND(2)):$JUSTIFY(RA2ND(2),$LENGTH(RACUT(3))),1:$JUSTIFY(0,$LENGTH(RACUT(3))))
+17 WRITE ?49,$SELECT($GET(RA2ND(3)):$JUSTIFY(RA2ND(3),$LENGTH(RACUT(3))),1:$JUSTIFY(0,$LENGTH(RACUT(3)))),?59,$SELECT($GET(RA2ND(4)):$JUSTIFY(RA2ND(4),$LENGTH(RACUT(3))+2),1:$JUSTIFY(0,$LENGTH(RACUT(3))+2))
+18 SET RA1=0
FOR RA4=1:1:4
SET RA1=RA1+$GET(RA2ND(RA4))
+19 WRITE !!,"Division Total: ",RA1,!!
+20 SET RAOUT=$$EOS^RAUTL5()
