RARTUVR3 ;HISC/GJC-Unverified Reports ;8/19/97 11:28
;;5.0;Radiology/Nuclear Medicine;**56,47**;Mar 16, 1998;Build 21
;Supported IA #2056 GET1^DIQ
EN1 ; Entry point for unverified reports option when sort is on
; Exam Date or Pri. Inter. Staff
; Data Storage:
; RABD="E":
; ^TMP($J,"RAUVR",Division,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam
; RABD="S":
; ^TMP($J,"RAUVR",Pri. Staff,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam
K ^TMP($J,"RAUVR") S (RAOUT,RAPAGE)=0,RASTATUS=""
D:RABD="E" ZERO ; zero out totals for division data
S RADTE=BEGDATE-.0001
F S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>ENDDATE)!(RAOUT) D
. S RADFN=0
. F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0!(RAOUT) D
.. S RADTI=0
.. F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:RADTI'>0!(RAOUT) D
... S RACN=0
... F S RACN=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)) Q:RACN'>0!(RAOUT) D
.... S RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) Q:'RACNI
.... S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
.... Q:'+$P(RA7003,"^",17) ; no report
.... S RA74=$G(^RARPT(+$P(RA7003,"^",17),0))
.... Q:$P(RA74,"^",5)="" ; no status, skeletal rpt created by imaging
.... Q:"^V^X^EF^"[("^"_$P(RA74,"^",5)_"^") ;Skip Verified, Deleted, E-filed rpts
.... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
.... ; ***** check if user selected this division & imaging type ****
.... S RA7002=$G(^RADPT(RADFN,"DT",RADTI,0)) ; 0 node Reg. Exams sub-file
.... S RADIVNME=$P($G(^DIC(4,+$P(RA7002,"^",3),0)),"^") ; dinum to file 4!
.... S:RADIVNME="" RADIVNME="Unknown"
.... Q:'$D(^TMP($J,"RA D-TYPE",RADIVNME))
.... Q:'$D(^TMP($J,"RA I-TYPE",$P($G(^RA(79.2,+$P(RA7002,"^",2),0)),"^")))
.... ;*****************************************************************
.... S (RAMEMLOW,RAPRTSET,RAPSET)=0 D EN1^RAUTL20 ; mem of a printset?
.... S:RAPRTSET RAPSET="1." S:RAMEMLOW RAPSET="1+"
.... S RAPIS=$$GET1^DIQ(200,+$P(RA7003,"^",15)_",",.01)
.... S:RAPIS="" RAPIS="Unknown"
.... S RAPAT=$G(^DPT(RADFN,0))
.... S RASSN=$$SSN^RAUTL() S:RASSN="" RASSN="Unknown"
.... S RAPAT=$P(RAPAT,"^") S:RAPAT="" RAPAT="Unknown"
.... ;*****************************************************************
.... ; Store off the data into our TMP global. First subscript is $J.
.... ; Second subscript is: RABD="E", exam date. I RABD="S", second
.... ; subscript is Pri. Int'g Staff. Other Subscripts: sub3-exam date,
.... ; sub4-patient name, sub5-case number
.... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003
.... S:RABD="S" ^TMP($J,"RAUVR",RAPIS,($P(RA7002,"^")\1),RAPAT,+$P(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003
.... S:RABD="E" ^TMP($J,"RAUVR",RADIVNME)=+$G(^TMP($J,"RAUVR",RADIVNME))+1
.... ;*****************************************************************
.... Q
... Q
.. Q
. Q
S:RABD="S" RAHD="UNVERIFIED IMAGING REPORTS BY PRIMARY INTERPRETING STAFF"
S:RABD="E" RAHD="UNVERIFIED IMAGING REPORTS BY DIVISION"
S $P(RADASH,"-",(IOM+1))=""
I '$D(^TMP($J,"RAUVR")) D Q
. N RA1,RANODATA S RANODATA="*** No Unverified Reports ***",RA1=""
. I RABD="S" D HDR W !!?(IOM-$L(RANODATA)\2),RANODATA
. I RABD="E" D
.. N RA1
.. S RA1="" F S RA=$O(^TMP($J,"RA D-TYPE",RA1)) Q:RA1="" D Q:RAOUT
... D HDR
... S RANODATA="*** No Unverified Reports for division: "_RA1_" ***"
... W !!?(IOM-$L(RANODATA)\2),RANODATA
... S:$O(^TMP($J,"RA D-TYPE",RA1))]"" RAOUT=$$EOS^RAUTL5()
... Q
.. Q
. Q
D GETDATA
KILL ; cleanup symbol table
K RA7002,RA7003,RA74,RACSE,RAEXDT,RAHD,RAMEMLOW,RANODE,RAPAT,RAPIS
K RAPRC,RAPRTSET,RAPSET,RAXSTAT
Q
HDR ; header code
W:$Y @IOF ; clear screen if not at top-of-page
S RAPAGE=RAPAGE+1 W !?(IOM-$L(RAHD)\2),RAHD
W !,$S(RABD="S":"Primary Interpreting Staff: ",1:"Division: "),RA1
W ?94,$$FMTE^XLFDT(DT,"1P")_" Page: "_RAPAGE
I $$USESSAN^RAHLRU1() W !,?93,"Exam",?102,"Report",!,"Patient",?21,"Patient ID",?34,"Exam Date",?44,"Case",?61,"Procedure",?93,"Status",?102,"Entered",?112,"Pri. Int'g Staff"
I '$$USESSAN^RAHLRU1() W !,?87,"Exam",?96,"Report",!,"Patient",?21,"Patient ID",?38,"Exam Date",?48,"Case",?55,"Procedure",?87,"Status",?96,"Entered",?106,"Pri. Int'g Staff"
W !,RADASH
Q
GETDATA ; get to the data
S RA1="",(RAPAGE,RAOUT)=0
F S RA1=$O(^TMP($J,"RAUVR",RA1)) Q:RA1="" D Q:RAOUT
. D HDR S RAEXDT=0
. I RABD="E",$G(^TMP($J,"RAUVR",RA1))=0 D Q
.. S X="*** No Unverified Reports for division ***"
.. W !!?(IOM-$L(X)\2),X
.. S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5()
.. Q
. F S RAEXDT=$O(^TMP($J,"RAUVR",RA1,RAEXDT)) Q:RAEXDT'>0 D Q:RAOUT
.. S RAPAT=""
.. F S RAPAT=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT)) Q:RAPAT="" D Q:RAOUT
... S RACSE=0
... F S RACSE=$O(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE)) Q:RACSE'>0 D Q:RAOUT
.... I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT
.... S RANODE=$G(^TMP($J,"RAUVR",RA1,RAEXDT,RAPAT,RACSE))
.... D PRTDATA
.... Q
... Q
.. Q
. S:$O(^TMP($J,"RAUVR",RA1))]"" RAOUT=$$EOS^RAUTL5()
. Q
Q
PRTDATA ; print the data
S RAPRC=$E($S($P(^RAMIS(71,+$P(RANODE,"^",4),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,30)
S:+$P(RANODE,"^") RAPRC=$TR($P(RANODE,"^"),"1","")_RAPRC
S RAXSTAT=$E($S($P(^RA(72,+$P(RANODE,"^",5),0),"^")]"":$P(^(0),"^"),1:"Unknown"),1,7)
S RARPTENT=$$FMTE^XLFDT(($P($G(^RARPT(+$P(RANODE,"^",19),0)),"^",6)\1),"2P")
S:RABD="S" RAPIS=RA1
S:RABD="E" RAPIS=$$GET1^DIQ(200,+$P(RANODE,"^",17)_",",.01)
S:RAPIS="" RAPIS="Unknown"
N RASSAN,RACNDSP S RASSAN=$P(RANODE,"^",33)
S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACSE)
I $$USESSAN^RAHLRU1() W !,$E(RAPAT,1,20),?21,$P(RANODE,"^",2),?34,$$FMTE^XLFDT(RAEXDT,"2P"),?44,RACNDSP,?61,RAPRC,?93,RAXSTAT,?102,RARPTENT,?112,$E(RAPIS,1,19)
I '$$USESSAN^RAHLRU1() W !,$E(RAPAT,1,20),?21,$P(RANODE,"^",2),?38,$$FMTE^XLFDT(RAEXDT,"2P"),?48,RACSE,?55,RAPRC,?87,RAXSTAT,?96,RARPTENT,?106,$E(RAPIS,1,25)
I $Y>(IOSL-4) S RAOUT=$$EOS^RAUTL5() D:'RAOUT HDR
Q
ZERO ; set division totals to zero
S X="" F S X=$O(^TMP($J,"RA D-TYPE",X)) Q:X="" S ^TMP($J,"RAUVR",X)=0
Q
RARTUVR3 ;HISC/GJC-Unverified Reports ;8/19/97 11:28
+1 ;;5.0;Radiology/Nuclear Medicine;**56,47**;Mar 16, 1998;Build 21
+2 ;Supported IA #2056 GET1^DIQ
EN1 ; Entry point for unverified reports option when sort is on
+1 ; Exam Date or Pri. Inter. Staff
+2 ; Data Storage:
+3 ; RABD="E":
+4 ; ^TMP($J,"RAUVR",Division,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam
+5 ; RABD="S":
+6 ; ^TMP($J,"RAUVR",Pri. Staff,Xam Date/Time,Patient,Case #)=print set? (1:yes, 0:no)_^_Pat ID_^_0 node of exam
+7 KILL ^TMP($JOB,"RAUVR")
SET (RAOUT,RAPAGE)=0
SET RASTATUS=""
+8 ; zero out totals for division data
IF RABD="E"
DO ZERO
+9 SET RADTE=BEGDATE-.0001
+10 FOR
SET RADTE=$ORDER(^RADPT("AR",RADTE))
IF RADTE'>0!(RADTE>ENDDATE)!(RAOUT)
QUIT
Begin DoDot:1
+11 SET RADFN=0
+12 FOR
SET RADFN=$ORDER(^RADPT("AR",RADTE,RADFN))
IF RADFN'>0!(RAOUT)
QUIT
Begin DoDot:2
+13 SET RADTI=0
+14 FOR
SET RADTI=$ORDER(^RADPT("AR",RADTE,RADFN,RADTI))
IF RADTI'>0!(RAOUT)
QUIT
Begin DoDot:3
+15 SET RACN=0
+16 FOR
SET RACN=$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN))
IF RACN'>0!(RAOUT)
QUIT
Begin DoDot:4
+17 SET RACNI=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
IF 'RACNI
QUIT
+18 SET RA7003=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+19 ; no report
IF '+$PIECE(RA7003,"^",17)
QUIT
+20 SET RA74=$GET(^RARPT(+$PIECE(RA7003,"^",17),0))
+21 ; no status, skeletal rpt created by imaging
IF $PIECE(RA74,"^",5)=""
QUIT
+22 ;Skip Verified, Deleted, E-filed rpts
IF "^V^X^EF^"[("^"_$PIECE(RA74,"^",5)_"^")
QUIT
+23 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
IF $GET(ZTSTOP)=1
SET RAOUT=1
IF RAOUT
QUIT
+24 ; ***** check if user selected this division & imaging type ****
+25 ; 0 node Reg. Exams sub-file
SET RA7002=$GET(^RADPT(RADFN,"DT",RADTI,0))
+26 ; dinum to file 4!
SET RADIVNME=$PIECE($GET(^DIC(4,+$PIECE(RA7002,"^",3),0)),"^")
+27 IF RADIVNME=""
SET RADIVNME="Unknown"
+28 IF '$DATA(^TMP($JOB,"RA D-TYPE",RADIVNME))
QUIT
+29 IF '$DATA(^TMP($JOB,"RA I-TYPE",$PIECE($GET(^RA(79.2,+$PIECE(RA7002,"^",2),0)),"^")))
QUIT
+30 ;*****************************************************************
+31 ; mem of a printset?
SET (RAMEMLOW,RAPRTSET,RAPSET)=0
DO EN1^RAUTL20
+32 IF RAPRTSET
SET RAPSET="1."
IF RAMEMLOW
SET RAPSET="1+"
+33 SET RAPIS=$$GET1^DIQ(200,+$PIECE(RA7003,"^",15)_",",.01)
+34 IF RAPIS=""
SET RAPIS="Unknown"
+35 SET RAPAT=$GET(^DPT(RADFN,0))
+36 SET RASSN=$$SSN^RAUTL()
IF RASSN=""
SET RASSN="Unknown"
+37 SET RAPAT=$PIECE(RAPAT,"^")
IF RAPAT=""
SET RAPAT="Unknown"
+38 ;*****************************************************************
+39 ; Store off the data into our TMP global. First subscript is $J.
+40 ; Second subscript is: RABD="E", exam date. I RABD="S", second
+41 ; subscript is Pri. Int'g Staff. Other Subscripts: sub3-exam date,
+42 ; sub4-patient name, sub5-case number
+43 IF RABD="E"
SET ^TMP($JOB,"RAUVR",RADIVNME,($PIECE(RA7002,"^")\1),RAPAT,+$PIECE(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003
+44 IF RABD="S"
SET ^TMP($JOB,"RAUVR",RAPIS,($PIECE(RA7002,"^")\1),RAPAT,+$PIECE(RA7003,"^"))=RAPSET_"^"_RASSN_"^"_RA7003
+45 IF RABD="E"
SET ^TMP($JOB,"RAUVR",RADIVNME)=+$GET(^TMP($JOB,"RAUVR",RADIVNME))+1
+46 ;*****************************************************************
+47 QUIT
End DoDot:4
+48 QUIT
End DoDot:3
+49 QUIT
End DoDot:2
+50 QUIT
End DoDot:1
+51 IF RABD="S"
SET RAHD="UNVERIFIED IMAGING REPORTS BY PRIMARY INTERPRETING STAFF"
+52 IF RABD="E"
SET RAHD="UNVERIFIED IMAGING REPORTS BY DIVISION"
+53 SET $PIECE(RADASH,"-",(IOM+1))=""
+54 IF '$DATA(^TMP($JOB,"RAUVR"))
Begin DoDot:1
+55 NEW RA1,RANODATA
SET RANODATA="*** No Unverified Reports ***"
SET RA1=""
+56 IF RABD="S"
DO HDR
WRITE !!?(IOM-$LENGTH(RANODATA)\2),RANODATA
+57 IF RABD="E"
Begin DoDot:2
+58 NEW RA1
+59 SET RA1=""
FOR
SET RA=$ORDER(^TMP($JOB,"RA D-TYPE",RA1))
IF RA1=""
QUIT
Begin DoDot:3
+60 DO HDR
+61 SET RANODATA="*** No Unverified Reports for division: "_RA1_" ***"
+62 WRITE !!?(IOM-$LENGTH(RANODATA)\2),RANODATA
+63 IF $ORDER(^TMP($JOB,"RA D-TYPE",RA1))]""
SET RAOUT=$$EOS^RAUTL5()
+64 QUIT
End DoDot:3
IF RAOUT
QUIT
+65 QUIT
End DoDot:2
+66 QUIT
End DoDot:1
QUIT
+67 DO GETDATA
KILL ; cleanup symbol table
+1 KILL RA7002,RA7003,RA74,RACSE,RAEXDT,RAHD,RAMEMLOW,RANODE,RAPAT,RAPIS
+2 KILL RAPRC,RAPRTSET,RAPSET,RAXSTAT
+3 QUIT
HDR ; header code
+1 ; clear screen if not at top-of-page
IF $Y
WRITE @IOF
+2 SET RAPAGE=RAPAGE+1
WRITE !?(IOM-$LENGTH(RAHD)\2),RAHD
+3 WRITE !,$SELECT(RABD="S":"Primary Interpreting Staff: ",1:"Division: "),RA1
+4 WRITE ?94,$$FMTE^XLFDT(DT,"1P")_" Page: "_RAPAGE
+5 IF $$USESSAN^RAHLRU1()
WRITE !,?93,"Exam",?102,"Report",!,"Patient",?21,"Patient ID",?34,"Exam Date",?44,"Case",?61,"Procedure",?93,"Status",?102,"Entered",?112,"Pri. Int'g Staff"
+6 IF '$$USESSAN^RAHLRU1()
WRITE !,?87,"Exam",?96,"Report",!,"Patient",?21,"Patient ID",?38,"Exam Date",?48,"Case",?55,"Procedure",?87,"Status",?96,"Entered",?106,"Pri. Int'g Staff"
+7 WRITE !,RADASH
+8 QUIT
GETDATA ; get to the data
+1 SET RA1=""
SET (RAPAGE,RAOUT)=0
+2 FOR
SET RA1=$ORDER(^TMP($JOB,"RAUVR",RA1))
IF RA1=""
QUIT
Begin DoDot:1
+3 DO HDR
SET RAEXDT=0
+4 IF RABD="E"
IF $GET(^TMP($JOB,"RAUVR",RA1))=0
Begin DoDot:2
+5 SET X="*** No Unverified Reports for division ***"
+6 WRITE !!?(IOM-$LENGTH(X)\2),X
+7 IF $ORDER(^TMP($JOB,"RAUVR",RA1))]""
SET RAOUT=$$EOS^RAUTL5()
+8 QUIT
End DoDot:2
QUIT
+9 FOR
SET RAEXDT=$ORDER(^TMP($JOB,"RAUVR",RA1,RAEXDT))
IF RAEXDT'>0
QUIT
Begin DoDot:2
+10 SET RAPAT=""
+11 FOR
SET RAPAT=$ORDER(^TMP($JOB,"RAUVR",RA1,RAEXDT,RAPAT))
IF RAPAT=""
QUIT
Begin DoDot:3
+12 SET RACSE=0
+13 FOR
SET RACSE=$ORDER(^TMP($JOB,"RAUVR",RA1,RAEXDT,RAPAT,RACSE))
IF RACSE'>0
QUIT
Begin DoDot:4
+14 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
IF $GET(ZTSTOP)=1
SET RAOUT=1
IF RAOUT
QUIT
+15 SET RANODE=$GET(^TMP($JOB,"RAUVR",RA1,RAEXDT,RAPAT,RACSE))
+16 DO PRTDATA
+17 QUIT
End DoDot:4
IF RAOUT
QUIT
+18 QUIT
End DoDot:3
IF RAOUT
QUIT
+19 QUIT
End DoDot:2
IF RAOUT
QUIT
+20 IF $ORDER(^TMP($JOB,"RAUVR",RA1))]""
SET RAOUT=$$EOS^RAUTL5()
+21 QUIT
End DoDot:1
IF RAOUT
QUIT
+22 QUIT
PRTDATA ; print the data
+1 SET RAPRC=$EXTRACT($SELECT($PIECE(^RAMIS(71,+$PIECE(RANODE,"^",4),0),"^")]"":$PIECE(^(0),"^"),1:"Unknown"),1,30)
+2 IF +$PIECE(RANODE,"^")
SET RAPRC=$TRANSLATE($PIECE(RANODE,"^"),"1","")_RAPRC
+3 SET RAXSTAT=$EXTRACT($SELECT($PIECE(^RA(72,+$PIECE(RANODE,"^",5),0),"^")]"":$PIECE(^(0),"^"),1:"Unknown"),1,7)
+4 SET RARPTENT=$$FMTE^XLFDT(($PIECE($GET(^RARPT(+$PIECE(RANODE,"^",19),0)),"^",6)\1),"2P")
+5 IF RABD="S"
SET RAPIS=RA1
+6 IF RABD="E"
SET RAPIS=$$GET1^DIQ(200,+$PIECE(RANODE,"^",17)_",",.01)
+7 IF RAPIS=""
SET RAPIS="Unknown"
+8 NEW RASSAN,RACNDSP
SET RASSAN=$PIECE(RANODE,"^",33)
+9 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACSE)
+10 IF $$USESSAN^RAHLRU1()
WRITE !,$EXTRACT(RAPAT,1,20),?21,$PIECE(RANODE,"^",2),?34,$$FMTE^XLFDT(RAEXDT,"2P"),?44,RACNDSP,?61,RAPRC,?93,RAXSTAT,?102,RARPTENT,?112,$EXTRACT(RAPIS,1,19)
+11 IF '$$USESSAN^RAHLRU1()
WRITE !,$EXTRACT(RAPAT,1,20),?21,$PIECE(RANODE,"^",2),?38,$$FMTE^XLFDT(RAEXDT,"2P"),?48,RACSE,?55,RAPRC,?87,RAXSTAT,?96,RARPTENT,?106,$EXTRACT(RAPIS,1,25)
+12 IF $Y>(IOSL-4)
SET RAOUT=$$EOS^RAUTL5()
IF 'RAOUT
DO HDR
+13 QUIT
ZERO ; set division totals to zero
+1 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"RA D-TYPE",X))
IF X=""
QUIT
SET ^TMP($JOB,"RAUVR",X)=0
+2 QUIT
