- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTUVR3 6240 printed Feb 19, 2025@00:05:58 Page 2
- 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