RARTUVR ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:01
;;5.0;Radiology/Nuclear Medicine;**29,56**;Mar 16, 1998;Build 3
;
; This routine displays the total number of reports that have a status
; other than V(erify) and the report is linked to a Resident, Staff or
; unknown physician. It builds the report by using the 'ASTAT' cross
; reference on File 74. It displays the report by division and imaging
; type. Within division/imaging type, it displays the number of reports
; by category (Resident and Staff). It displays the number of unverified
; reports by Interpreting Physician within a category.
; The routine checks the PRIMARY INTERPRETING RESIDENT and PRIMARY
; INTERPRETING STAFF fields (File 70) associated with a report.
; If a primary Resident is associated with the report, then the report
; is counted towards that Resident.
; If a primary Staff physician is associated with the report, then the
; report is counted towards that Interpreting Staff.
; If neither of the above are true the report is counted toward unknown.
;
EN ; unverified reports report
K ^TMP($J)
I '$D(^RARPT("ASTAT")) W !!,*7,?5,"There are no Unverified Reports." Q
;
; Select Imaging Type, if exists
I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
S RAXIT=$$SETUPDI^RAUTL7() I RAXIT K RAXIT Q
S X=$$DIVLOC^RAUTL7() I X D KILL Q
S RACNT=0,X="" F S X=$O(RACCESS(DUZ,"DIV-IMG",X)) Q:X']"" D
. Q:'$D(^TMP($J,"RA D-TYPE",X)) S Y=""
. F S Y=$O(RACCESS(DUZ,"DIV-IMG",X,Y)) Q:Y']"" D
.. S:$D(^TMP($J,"RA I-TYPE",Y)) ^TMP($J,"RAUVR",X,Y)=0,RACNT=RACNT+1
.. Q
. Q
W !
ASKBD K DIR S DIR("B")="b"
S DIR("?",1)="Enter 'b' for a brief format, 'd' for a detailed format, "
S DIR("?",2)="'e' for a format sorted by exam date, 's' for a format"
S DIR("?",3)="sorted by Primary Interpreting Staff."
S DIR("?")="This is mandatory."
S DIR(0)="S^b:Brief;d:Detailed;e:Exam Date, Itemized List;s:Staff, Itemized List"
D ^DIR G:$D(DIRUT) KILL
S RABD=$$UP^XLFSTR(Y) K DIR,DIROUT,DIRUT,DUOUT,DTOUT
I RABD="S"!(RABD="E") D
. W ! D 132^RAMAINP S RAFILE="EXAM REGISTERED"
. Q
E S RAFILE="REPORT ENTERED"
;
ASKTHRU S RASKTIME=1 W !!,"(The date range refers to DATE "_RAFILE_")"
D DATE^RAUTL K RAFILE,RASKTIME ;allow time of day input
G:X="^" KILL G:'$D(ENDDATE)!('$D(BEGDATE)) KILL
S:$L(ENDDATE)=7 ENDDATE=ENDDATE_".2359"
G:"^E^S^"[("^"_RABD_"^") DEVICE ; skip date/time cut-off
;
ASKCUT S RACUT(1)=24,RACUT(2)=48,RACUT(3)=96
W !!,"Default cut-off limits (in hours) for aging of reports are :"
W !!?35 F RA1=1:1:3 W RACUT(RA1)," "
K DIR S DIR("A")="Do you want to enter different cut-off limits",DIR("B")="N",DIR("?")="Enter Y only if you want to change the above limits",DIR("??")="This is optional",DIR(0)="Y"
W ! D ^DIR K DIR G:X="^" KILL G:+Y<1 DEVICE
S DIR("?")="Enter number of hours as the cut-off limit"
F RA1=1:1:3 S DIR(0)="N^"_$S(RA1=1:0,1:RACUT(RA1-1))_":87660",DIR("A")="Enter the "_$S(RA1=1:"first",RA1=2:"second",1:"third")_" cutoff hours" D ^DIR Q:+Y<1 S RACUT(RA1)=Y
K DIR I +Y<1 W !!,"Try again " G ASKCUT
;
DEVICE ; select device
S ZTRTN="START^RARTUVR",ZTSAVE("^TMP($J,""RA D-TYPE"",")="",ZTSAVE("^TMP($J,""RA I-TYPE"",")="",ZTSAVE("^TMP($J,""RAUVR"",")="",ZTSAVE("RACNT")="",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("RACUT*")="",ZTSAVE("RABD")=""
W ! D ZIS^RAUTL I RAPOP D KILL Q
START ; start processing
U IO S:$D(ZTQUEUED) ZTREQ="@"
I "^E^S^"[("^"_RABD_"^") D EN1^RARTUVR3 D KILL Q
S RADIVNME=""
F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME']"" S RAITNAME="" F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME']"" D
. S ^TMP($J,RADIVNME,RAITNAME,"RESCNT")=0
. S ^TMP($J,RADIVNME,RAITNAME,"STFCNT")=0
. S ^TMP($J,RADIVNME,RAITNAME,"UNKCNT")=0
. Q
;
;
S RASTATUS="",RAOUT=0
F S RASTATUS=$O(^RARPT("ASTAT",RASTATUS)) Q:RASTATUS=""!(RAOUT) D
. S RARPT=0,RAOUT=0
. F S RARPT=$O(^RARPT("ASTAT",RASTATUS,RARPT)) Q:RARPT'>0!(RAOUT) D
..;use Report Status to exclude, as Verf'd rpt may have leftover "ASTAT"
..;exclude Verified, Deleted, and Electronically Filed reports
.. Q:"^V^X^EF^"[("^"_$P($G(^RARPT(RARPT,0)),U,5)_"^")
.. S RARPTENT=$P($G(^RARPT(RARPT,0)),U,6)
.. Q:RARPTENT<BEGDATE!(RARPTENT>ENDDATE)
.. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1
.. S Y=RARPT D RASET^RAUTL2 Q:'Y S RAX=Y
.. S RAPRES=$P(RAX,"^",12),RAPSTF=$P(RAX,"^",15)
.. ; Check if Staff & Resident the same, if so, use Staff only
.. I (RAPSTF>0),(RAPRES=RAPSTF) S RAPRES=""
.. S RAIP=""
.. S:RAPRES>0 RAIP=RAIP_"R"
.. S:RAPSTF>0 RAIP=RAIP_"S"
.. S:RAIP="" RAIP="U"
.. D BTG^RARTUVR1
.. Q
. Q
DIV ; walk through tmp global, start with 'division'
S (RACNT(0),RAOUT,RAPAGE)=0,RADIVNME=""
S X="NOW",%DT="T" D ^%DT K %DT D D^RAUTL S RARUNDAT=Y
S $P(RADASH,"-",IOM)="",$P(RAEQUAL,"=",IOM+1)=""
F S RADIVNME=$O(^TMP($J,"RAUVR",RADIVNME)) Q:RADIVNME=""!(RAOUT) D IT Q:RAOUT D DIVSUM^RARTUVR1 Q:RAOUT
KILL ; kill variables & close device
K ^TMP($J),POP,RAPOP,RACN,RACNI,RACNT,RAD,RADATE,RADFN,RADIVNME,RADIVNUM,RADTI,RADTE,RAFL,RAFLG,RAIP,RAIPNAME,RAITNAME,RAITNUM,RAOUT,RAPAGE,RAQUIT,RAPRES,RAPSTF,RARAD,RARE,RARPT,RARS,RASTATUS,RASTRING,RAX,RAXIT,X,Y,ZTQUEUED,ZTSTOP
K RA1,RA2,RA3,RA4,RABD,RACUT,RADASH,RAEQUAL,RAHOURS,RARPTENT,RARUNDAT,RASSN
K:$D(RAPSTX) RACCESS,RAPSTX
K BEGDATE,DIR,DIRUT,DUOUT,ENDDATE,I,RAMES,ZTDESC,ZTRTN,ZTSAVE
D CLOSE^RAUTL
Q
IT ; imaging type
S RAITNAME=""
F S RAITNAME=$O(^TMP($J,"RAUVR",RADIVNME,RAITNAME)) Q:RAITNAME=""!(RAOUT) D PRINT^RARTUVR2 Q:RAOUT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTUVR 5639 printed Apr 09, 2024@21:39:18 Page 2
RARTUVR ;HISC/FPT,SWM AISC/RMO-Unverified Reports ;8/19/97 11:01
+1 ;;5.0;Radiology/Nuclear Medicine;**29,56**;Mar 16, 1998;Build 3
+2 ;
+3 ; This routine displays the total number of reports that have a status
+4 ; other than V(erify) and the report is linked to a Resident, Staff or
+5 ; unknown physician. It builds the report by using the 'ASTAT' cross
+6 ; reference on File 74. It displays the report by division and imaging
+7 ; type. Within division/imaging type, it displays the number of reports
+8 ; by category (Resident and Staff). It displays the number of unverified
+9 ; reports by Interpreting Physician within a category.
+10 ; The routine checks the PRIMARY INTERPRETING RESIDENT and PRIMARY
+11 ; INTERPRETING STAFF fields (File 70) associated with a report.
+12 ; If a primary Resident is associated with the report, then the report
+13 ; is counted towards that Resident.
+14 ; If a primary Staff physician is associated with the report, then the
+15 ; report is counted towards that Interpreting Staff.
+16 ; If neither of the above are true the report is counted toward unknown.
+17 ;
EN ; unverified reports report
+1 KILL ^TMP($JOB)
+2 IF '$DATA(^RARPT("ASTAT"))
WRITE !!,*7,?5,"There are no Unverified Reports."
QUIT
+3 ;
+4 ; Select Imaging Type, if exists
+5 IF $ORDER(RACCESS(DUZ,""))=""
DO SETVARS^RAPSET1(0)
SET RAPSTX=""
+6 SET RAXIT=$$SETUPDI^RAUTL7()
IF RAXIT
KILL RAXIT
QUIT
+7 SET X=$$DIVLOC^RAUTL7()
IF X
DO KILL
QUIT
+8 SET RACNT=0
SET X=""
FOR
SET X=$ORDER(RACCESS(DUZ,"DIV-IMG",X))
if X']""
QUIT
Begin DoDot:1
+9 if '$DATA(^TMP($JOB,"RA D-TYPE",X))
QUIT
SET Y=""
+10 FOR
SET Y=$ORDER(RACCESS(DUZ,"DIV-IMG",X,Y))
if Y']""
QUIT
Begin DoDot:2
+11 if $DATA(^TMP($JOB,"RA I-TYPE",Y))
SET ^TMP($JOB,"RAUVR",X,Y)=0
SET RACNT=RACNT+1
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 WRITE !
ASKBD KILL DIR
SET DIR("B")="b"
+1 SET DIR("?",1)="Enter 'b' for a brief format, 'd' for a detailed format, "
+2 SET DIR("?",2)="'e' for a format sorted by exam date, 's' for a format"
+3 SET DIR("?",3)="sorted by Primary Interpreting Staff."
+4 SET DIR("?")="This is mandatory."
+5 SET DIR(0)="S^b:Brief;d:Detailed;e:Exam Date, Itemized List;s:Staff, Itemized List"
+6 DO ^DIR
if $DATA(DIRUT)
GOTO KILL
+7 SET RABD=$$UP^XLFSTR(Y)
KILL DIR,DIROUT,DIRUT,DUOUT,DTOUT
+8 IF RABD="S"!(RABD="E")
Begin DoDot:1
+9 WRITE !
DO 132^RAMAINP
SET RAFILE="EXAM REGISTERED"
+10 QUIT
End DoDot:1
+11 IF '$TEST
SET RAFILE="REPORT ENTERED"
+12 ;
ASKTHRU SET RASKTIME=1
WRITE !!,"(The date range refers to DATE "_RAFILE_")"
+1 ;allow time of day input
DO DATE^RAUTL
KILL RAFILE,RASKTIME
+2 if X="^"
GOTO KILL
if '$DATA(ENDDATE)!('$DATA(BEGDATE))
GOTO KILL
+3 if $LENGTH(ENDDATE)=7
SET ENDDATE=ENDDATE_".2359"
+4 ; skip date/time cut-off
if "^E^S^"[("^"_RABD_"^")
GOTO DEVICE
+5 ;
ASKCUT SET RACUT(1)=24
SET RACUT(2)=48
SET RACUT(3)=96
+1 WRITE !!,"Default cut-off limits (in hours) for aging of reports are :"
+2 WRITE !!?35
FOR RA1=1:1:3
WRITE RACUT(RA1)," "
+3 KILL DIR
SET DIR("A")="Do you want to enter different cut-off limits"
SET DIR("B")="N"
SET DIR("?")="Enter Y only if you want to change the above limits"
SET DIR("??")="This is optional"
SET DIR(0)="Y"
+4 WRITE !
DO ^DIR
KILL DIR
if X="^"
GOTO KILL
if +Y<1
GOTO DEVICE
+5 SET DIR("?")="Enter number of hours as the cut-off limit"
+6 FOR RA1=1:1:3
SET DIR(0)="N^"_$SELECT(RA1=1:0,1:RACUT(RA1-1))_":87660"
SET DIR("A")="Enter the "_$SELECT(RA1=1:"first",RA1=2:"second",1:"third")_" cutoff hours"
DO ^DIR
if +Y<1
QUIT
SET RACUT(RA1)=Y
+7 KILL DIR
IF +Y<1
WRITE !!,"Try again "
GOTO ASKCUT
+8 ;
DEVICE ; select device
+1 SET ZTRTN="START^RARTUVR"
SET ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
SET ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
SET ZTSAVE("^TMP($J,""RAUVR"",")=""
SET ZTSAVE("RACNT")=""
SET ZTSAVE("BEGDATE")=""
SET ZTSAVE("ENDDATE")=""
SET ZTSAVE("RACUT*")=""
SET ZTSAVE("RABD")=""
+2 WRITE !
DO ZIS^RAUTL
IF RAPOP
DO KILL
QUIT
START ; start processing
+1 USE IO
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF "^E^S^"[("^"_RABD_"^")
DO EN1^RARTUVR3
DO KILL
QUIT
+3 SET RADIVNME=""
+4 FOR
SET RADIVNME=$ORDER(^TMP($JOB,"RAUVR",RADIVNME))
if RADIVNME']""
QUIT
SET RAITNAME=""
FOR
SET RAITNAME=$ORDER(^TMP($JOB,"RAUVR",RADIVNME,RAITNAME))
if RAITNAME']""
QUIT
Begin DoDot:1
+5 SET ^TMP($JOB,RADIVNME,RAITNAME,"RESCNT")=0
+6 SET ^TMP($JOB,RADIVNME,RAITNAME,"STFCNT")=0
+7 SET ^TMP($JOB,RADIVNME,RAITNAME,"UNKCNT")=0
+8 QUIT
End DoDot:1
+9 ;
+10 ;
+11 SET RASTATUS=""
SET RAOUT=0
+12 FOR
SET RASTATUS=$ORDER(^RARPT("ASTAT",RASTATUS))
if RASTATUS=""!(RAOUT)
QUIT
Begin DoDot:1
+13 SET RARPT=0
SET RAOUT=0
+14 FOR
SET RARPT=$ORDER(^RARPT("ASTAT",RASTATUS,RARPT))
if RARPT'>0!(RAOUT)
QUIT
Begin DoDot:2
+15 ;use Report Status to exclude, as Verf'd rpt may have leftover "ASTAT"
+16 ;exclude Verified, Deleted, and Electronically Filed reports
+17 if "^V^X^EF^"[("^"_$PIECE($GET(^RARPT(RARPT,0)),U,5)_"^")
QUIT
+18 SET RARPTENT=$PIECE($GET(^RARPT(RARPT,0)),U,6)
+19 if RARPTENT<BEGDATE!(RARPTENT>ENDDATE)
QUIT
+20 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAOUT=1
if RAOUT=1
QUIT
+21 SET Y=RARPT
DO RASET^RAUTL2
if 'Y
QUIT
SET RAX=Y
+22 SET RAPRES=$PIECE(RAX,"^",12)
SET RAPSTF=$PIECE(RAX,"^",15)
+23 ; Check if Staff & Resident the same, if so, use Staff only
+24 IF (RAPSTF>0)
IF (RAPRES=RAPSTF)
SET RAPRES=""
+25 SET RAIP=""
+26 if RAPRES>0
SET RAIP=RAIP_"R"
+27 if RAPSTF>0
SET RAIP=RAIP_"S"
+28 if RAIP=""
SET RAIP="U"
+29 DO BTG^RARTUVR1
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
DIV ; walk through tmp global, start with 'division'
+1 SET (RACNT(0),RAOUT,RAPAGE)=0
SET RADIVNME=""
+2 SET X="NOW"
SET %DT="T"
DO ^%DT
KILL %DT
DO D^RAUTL
SET RARUNDAT=Y
+3 SET $PIECE(RADASH,"-",IOM)=""
SET $PIECE(RAEQUAL,"=",IOM+1)=""
+4 FOR
SET RADIVNME=$ORDER(^TMP($JOB,"RAUVR",RADIVNME))
if RADIVNME=""!(RAOUT)
QUIT
DO IT
if RAOUT
QUIT
DO DIVSUM^RARTUVR1
if RAOUT
QUIT
KILL ; kill variables & close device
+1 KILL ^TMP($JOB),POP,RAPOP,RACN,RACNI,RACNT,RAD,RADATE,RADFN,RADIVNME,RADIVNUM,RADTI,RADTE,RAFL,RAFLG,RAIP,RAIPNAME,RAITNAME,RAITNUM,RAOUT,RAPAGE,RAQUIT,RAPRES,RAPSTF,RARAD,RARE,RARPT,RARS,RASTATUS,RASTRING,RAX,RAXIT,X,Y,ZTQUEUED,ZTSTOP
+2 KILL RA1,RA2,RA3,RA4,RABD,RACUT,RADASH,RAEQUAL,RAHOURS,RARPTENT,RARUNDAT,RASSN
+3 if $DATA(RAPSTX)
KILL RACCESS,RAPSTX
+4 KILL BEGDATE,DIR,DIRUT,DUOUT,ENDDATE,I,RAMES,ZTDESC,ZTRTN,ZTSAVE
+5 DO CLOSE^RAUTL
+6 QUIT
IT ; imaging type
+1 SET RAITNAME=""
+2 FOR
SET RAITNAME=$ORDER(^TMP($JOB,"RAUVR",RADIVNME,RAITNAME))
if RAITNAME=""!(RAOUT)
QUIT
DO PRINT^RARTUVR2
if RAOUT
QUIT
+3 QUIT
+4 ;
