Routine: RARTUVR1

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

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

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

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()

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()

RARTUVR1.m