- RAPM2 ;HOIFO/TH-Radiology Performance Monitors/Indicator; ;3/20/04 12:41
- ;;5.0;Radiology/Nuclear Medicine;**37,44,48,63,67,99,47**;Mar 16, 1998;Build 21
- ; IA 10090 allows Read w/Fileman for entire file 4
- ; Supported IA #10103 reference to ^XLFDT
- ; Supported IA #2056 reference to ^DIQ
- ; Supported IA #2541 reference to KSP^XUPARAM
- ; RVD - 3/20/09 p99
- ; Print Detail report
- DETAIL ; Print Detail report
- I ($Y+5)>IOSL!(RARPT="B") D
- . I IO=IO(0),($E(IOST,1,2)="C-") D
- . . R !,"Press RETURN to continue. ",X:DTIME
- D HDR("D")
- D PRTTOT
- D DHDR
- D DRPT Q:RAXIT
- D DFOOT
- Q
- ;
- PRTTOT ; Print total number of reports
- S RATOTCNT=+$G(^TMP($J,"RAPM","TOTAL"))
- W !,"Total number of reports expected for procedures performed during specified date range: ",$J(RATOTCNT,$L(RATOTCNT))
- Q
- ;
- DHDR ; Header
- I ($Y+5)>IOSL D
- . S RAPG=RAPG+1,RAHD(0)="Detail Verification Timeliness Report"
- . W @IOF,!?(RAIOM-$L(RAHD(0))\2),RAHD(0),?(RAIOM-10),"Page: ",$G(RAPG)
- W !!,?34,"Date/Time",?49,"Date/Time",?69,"Date/Time",?102,"Cat"
- W ?106,"Rpt",?110,"Img",?116,"Procedure"
- W !,"Patient Name",?17,"Case #",?34,"Registered",?49,"Transcribed",?63,"Hrs"
- W ?69,"Verified",?83,"Hrs",?88,"Radiologist",?102,"Exm",?106,"Sts"
- W ?110,"Typ",?119,"Name",!
- Q
- ;
- DRPT ; Read records
- S RAXIT=0
- I '$D(^TMP($J,"RAPM2")) W !!?30,"No data to print...",!!!!! Q
- S D1="" F S D1=$O(^TMP($J,"RAPM2",D1)) Q:D1="" Q:RAXIT D
- . S D2="" F S D2=$O(^TMP($J,"RAPM2",D1,D2)) Q:D2="" Q:RAXIT D
- . . S D3="" F S D3=$O(^TMP($J,"RAPM2",D1,D2,D3)) Q:D3="" Q:RAXIT D
- . . . D SRT
- Q
- ;
- SRT ; Read records
- I RASORT="C"!(RASORT="P") S RAREC=$G(^TMP($J,"RAPM2",D1,D2,D3)) D DET Q
- S D4="" F S D4=$O(^TMP($J,"RAPM2",D1,D2,D3,D4)) Q:D4="" Q:RAXIT D
- . S RAREC=$G(^TMP($J,"RAPM2",D1,D2,D3,D4)) D DET
- Q
- ;
- DET ; Print detail records
- ; use Transcription elasped hr for all sorts, except if sort by Verif.
- S RAVAL=$S(RASORT="V":$P(RAREC,U,13),1:$P(RAREC,U,12))
- ; remove symbols before comparison
- S:$E(RAVAL)="<" RAVAL=.5 S:$E(RAVAL)=">" RAVAL=999
- ; include PENDING and those with hours > RASINCE
- I RAVAL'="",RAVAL<RASINCE Q
- I ($Y+5)>IOSL D
- . I IO=IO(0) D
- . . I $E(IOST,1,2)="C-" R !,"Press RETURN to continue or ""^"" to exit. ",X:DTIME S:X="^" RAXIT=1
- . Q:RAXIT
- . D DHDR
- Q:RAXIT
- W !,$E($P(RAREC,U,2),1,14)
- W ?16,$P(RAREC,U,1)
- W ?33,$P($$FMTE^XLFDT($P(RAREC,U,3),"2FS"),":",1,2)
- W ?48,$P($$FMTE^XLFDT($P(RAREC,U,4),"2FS"),":",1,2),?63,$J($P(RAREC,U,12),4)
- W ?68,$P($$FMTE^XLFDT($P(RAREC,U,5),"2FS"),":",1,2),?82,$J($P(RAREC,U,13),4)
- I $P(RAREC,U,6)'="" W ?88,$E($P(RAREC,U,6),1,14)
- W ?104,$P(RAREC,U,7),?107,$P(RAREC,U,8)
- W ?110,$E($P(RAREC,U,9),1,3),?114,$E($P(RAREC,U,14),1,15)
- W:$P(RAREC,U,11)="" ?130,"*D"
- Q
- ;
- I ($Y+5)>IOSL D
- . I IO=IO(0) D
- . . I $E(IOST,1,2)="C-" R !,"Press RETURN to continue. ",X:DTIME
- . D DHDR
- W !!,"Note: Category of Exam: 'I' for Inpatient; 'O' for Outpatient; "
- W "'C' for Contract; 'S' for Sharing; 'E' for Employee; 'R' for Research"
- W !," Report Status: 'V' for Verififed; 'R' for Released/Not "
- W "Verified; 'PD' for Problem Draft; 'D' for Draft"
- W:RANODIV !," *D = Division is missing"
- W !!?5,"* A printset, i.e., a set of multiple exams that share the same report, will be expected to have 1 report."
- W !!?5,"* Cancelled and ""No Credit"" cases are excluded from this report."
- Q
- ;
- STORE ; Store detail information
- Q:RARPT="S"
- ; for storage subscript: if no rpt dt, set to neg
- S RADHT=$S(RARPTDT="":-1,1:RATDFHR)
- S RADHV=$S(RAVERDT="":-1,1:RAVDFHR)
- ; for display: truncate decimal portion of hours
- S:RATDFHR'="" RATDFHR=RATDFHR\1
- S:RAVDFHR'="" RAVDFHR=RAVDFHR\1
- S RATDFHR=$S(RATDFHR="":"",RATDFHR<1:"<1",RATDFHR>999:">999",1:RATDFHR)
- S RAVDFHR=$S(RAVDFHR="":"",RAVDFHR<1:"<1",RAVDFHR>999:">999",1:RAVDFHR)
- ;
- I $$USESSAN^RAHLRU1() S RAREC1=RACNDSP_U_RAPATNM_U_RADTE_U_RARPTDT_U
- I '$$USESSAN^RAHLRU1() S RAREC1=RACN_U_RAPATNM_U_RADTE_U_RARPTDT_U
- S RAREC1=RAREC1_RAVERDT_U_RAPRIMNM_U_RACAT_U_RARPTST_U_RAIMGTYP_U
- S RAREC1=RAREC1_RADFN_U_RACHKDIV_U_RATDFHR_U_RAVDFHR_U_RAPRCN
- ;
- I RASORT="C" S ^TMP($J,"RAPM2",$P(RADTE,"."),RACN,RAPATNM)=RAREC1
- I RASORT="P" S ^TMP($J,"RAPM2",RAPATNM,$P(RADTE,"."),RACN)=RAREC1
- I RASORT="I" S ^TMP($J,"RAPM2",RAIMGTYP,$P(RADTE,"."),RACN,RAPATNM)=RAREC1
- I RASORT="E" S ^TMP($J,"RAPM2",RACAT,$P(RADTE,"."),RACN,RAPATNM)=RAREC1
- I RASORT="R" S ^TMP($J,"RAPM2",RAPRIMNM,$P(RADTE,"."),RACN,RAPATNM)=RAREC1
- I RASORT="T" S ^TMP($J,"RAPM2",RADHT,RADTE,RACN,RAPATNM)=RAREC1
- I RASORT="V" S ^TMP($J,"RAPM2",RADHV,RADTE,RACN,RAPATNM)=RAREC1
- Q
- EMAIL ; Ask if ready to email the summary report
- N RA1
- W ! S DIR(0)="Y"
- S DIR("A")="Send summary report to local mail group ""G.RAD PERFORMANCE INDICATOR"""
- S DIR("B")="Yes"
- D ^DIR
- Q:$D(DIRUT)
- S RAANS=Y
- S RA1=$O(^RA(79,0)) Q:'RA1
- I '$O(^RA(79,RA1,1,0)) D Q
- . W !!,?5,"No OUTLOOK mail group(s) have been entered yet."
- . Q
- W ! S DIR(0)="Y"
- S DIR("A")="Send summary report to OUTLOOK mail group(s)"
- S DIR("B")="Yes"
- D ^DIR
- S RAANS2=Y
- I RAANS2 D CKMONTH^RAPM4
- Q
- SEND ; Send summary report to mail group
- I RAANS=0,RAANS2=0 Q
- N RA1,RA2,RASVSUB,RASVTEXT,RASTR
- S:$G(RAP99) XMSUB="Radiology Timeliness Performance Reports"
- S:'$G(RAP99) XMSUB="Radiology Summary Verification Timeliness"
- S XMDUZ=DUZ
- S XMTEXT="^TMP($J,""RAPM"","
- S RASVSUB=XMSUB,RASVTEXT=XMTEXT
- I RAANS=1 D
- . S XMY("G.RAD PERFORMANCE INDICATOR")=""
- . D ^XMD
- . K XMY
- . Q
- I RAANS2=1 D
- . S RA1=$O(^RA(79,0)) Q:'RA1
- . S XMSUB=RASVSUB,XMTEXT=RASVTEXT
- . S RA2=0
- .; Outlook mailgroup flagged for HQ should always get automatic mid-
- .; mid-month rpt, but only get user-initiated rpt if user specifies so
- .;
- .; All non-HQ outlook mailgroups get all reports, including autom rpt
- .;
- . F S RA2=$O(^RA(79,RA1,1,RA2)) Q:'RA2 S RASTR=$G(^(RA2,0)) D
- .. I $P(RASTR,U,2)="Y",$G(RAUTOM) S XMY($P(RASTR,U))=""
- .. I $P(RASTR,U,2)'="Y" S XMY($P(RASTR,U))=""
- .. Q
- . Q:'$D(XMY)
- . D ^XMD
- . K XMY
- . Q
- K XMDUZ
- Q
- HDR(RATYP) ; Print appropriate header and process wait and time
- U:RAIO IO S RAPG=$G(RAPG)+1
- I RAPG>1!($E(IOST,1,2)="C-") W:RAIO @IOF
- I $E(IOST,1,2)="P-",(RAPG>1) W:RAIO @IOF
- S RAHD(0)=$S(RATYP="S":"Summary",RATYP="D":"Detail",1:"")
- S RAHD(0)=RAHD(0)_" Verification Timeliness Report"
- S RAIOM=$S(RATYP="S":80,1:IOM)
- W:RAIO !?(RAIOM-$L(RAHD(0))\2),RAHD(0),?(RAIOM-10),"Page: ",$G(RAPG),!
- I RATYP="S" S RAN=RAN+1 D
- . S ^TMP($J,"RAPM",RAN)=" Summary Verification Timeliness Report Page: "_$G(RAPG) S RAN=RAN+1
- . S ^TMP($J,"RAPM",RAN)="",RAN=RAN+1
- ;
- S:'$G(DUZ(2)) DUZ(2)=$$KSP^XUPARAM("INST") ;added by p99
- D GETS^DIQ(4,DUZ(2),".01;14*;99","E","RAR","RAMSG")
- K X
- S X(1)=RAR(4,DUZ(2)_",",.01,"E") ; Name of facility
- S X(2)=RAR(4,DUZ(2)_",",99,"E") ; Station Number
- I $D(RAR(4.014)) D
- . S X(3)=RAR(4.014,"1,"_DUZ(2)_",",.01,"E") ; Association
- . S X(4)=RAR(4.014,"1,"_DUZ(2)_",",1,"E") ; Parent of Association
- . S X(5)=$S(X(3)="VISN":X(4),1:"") ; should be VISN number
- E S X(5)=""
- ;
- W:RAIO !,"Facility: ",X(1),?41,"Station: ",X(2),?60,"VISN: ",X(5)
- I RATYP="S" D
- . S $P(X(6)," ",79)=""
- . S $E(X(6),1,(10+$L(X(1))))="Facility: "_X(1)
- . S $E(X(6),41,(50+$L(X(2))))="Station: "_X(2)
- . S $E(X(6),60,(66+$L(X(5))))="VISN: "_X(5)
- . S ^TMP($J,"RAPM",RAN)=X(6)
- . S RAN=RAN+1
- . Q
- W !,"Division: "
- I RATYP="S" S ^TMP($J,"RAPM",RAN)="Division: "
- D DIV
- S:(RATYP="S") RAN=RAN+1
- ;
- W:RAIO !,"Exam Date Range: "
- W:RAIO $$FMTE^XLFDT(RABDATE,"2D")," - ",$$FMTE^XLFDT(RAEDATE,"2D")
- I RATYP="S" D
- .S:'$G(RAP99) ^TMP($J,"RAPM",RAN)=""
- .S RAN=RAN+1,^TMP($J,"RAPM",RAN)="Exam Date Range: "_$$FMTE^XLFDT(RABDATE,"2D")_" - "_$$FMTE^XLFDT(RAEDATE,"2D")_" " S RAN=RAN+1
- ;
- W:RAIO !,"Imaging Type(s): "
- I RATYP="S",'$G(RAP99) S RAN=RAN+1,^TMP($J,"RAPM",RAN)="",RAN=RAN+1,^TMP($J,"RAPM",RAN)="Imaging Type(s): "
- D IMG
- S:RATYP="S" RAN=RAN+1
- ;
- ; Run date and time
- S NOW=$$NOW^XLFDT,NOW=$P(NOW,".",1)_"."_$E($P(NOW,".",2),1,4)
- W:RAIO !,"Run Date/Time: ",$$FMTE^XLFDT(NOW,"2P"),!
- I RATYP="S" S RAN=RAN+1,^TMP($J,"RAPM",RAN)="Run Date/Time: "_$$FMTE^XLFDT(NOW,"2P"),RAN=RAN+1
- I RARAD D
- . W:RAIO !,"Primary Interpreting Staff Physician: ",$$GET1^DIQ(200,RARAD,.01),!
- . I RATYP="S" D
- .. S ^TMP($J,"RAPM",RAN)="",RAN=RAN+1
- .. S ^TMP($J,"RAPM",RAN)="Primary Interpreting Staff Physician: "_$$GET1^DIQ(200,RARAD,.01),RAN=RAN+1
- .. Q
- . Q
- I (RARPT="D"!(RARPT="B")),(RATYP'="S") D
- . S RASRT=$S(RASORT="C":"Case Number",RASORT="E":"Category of Exam",RASORT="I":"Imaging Type",RASORT="P":"Patient Name",RASORT="R":"Radiologist",RASORT="T":"Hrs to Transcription",RASORT="V":"Hrs to Verification",1:"")
- . W:RAIO !,"Sorted by: ",RASRT,?45,"Min. hours elasped to "_$S(RASORT="V":"Verification",1:"Transcription")_": "_RASINCE
- Q
- DIV ; List selected Division
- Q:'$D(^TMP($J,"RA D-TYPE"))
- S RADIV="" F I=1:1 S RADIV=$O(^TMP($J,"RA D-TYPE",RADIV)) Q:RADIV="" D
- . I $X'>(RAIOM-$L("Division(s): ")) D
- . . W:RAIO RADIV_$S($O(^TMP($J,"RA D-TYPE",RADIV))]"":", ",1:"")
- . . I RATYP="S" S ^TMP($J,"RAPM",RAN)=^TMP($J,"RAPM",RAN)_RADIV_$S($O(^TMP($J,"RA D-TYPE",RADIV))]"":", ",1:"")
- . I $X>(RAIOM-$L("Division(s): ")) D
- . . W:RAIO !?($X+$L("Division(s): "))
- . . I RATYP="S" S:'$G(RAP99) RAN=RAN+1,^TMP($J,"RAPM",RAN)=" "
- Q
- IMG ; List selected Imaging Type(s)
- Q:'$D(^TMP($J,"RA I-TYPE"))
- ;N RALMAX,RALUSED,RATAIL,RALDENT
- S RALDENT=$L("Imaging Type(s): ")
- S RALMAX=RAIOM-RALDENT
- S RALUSED=0
- S RAIMG="" F J=1:1 S RAIMG=$O(^TMP($J,"RA I-TYPE",RAIMG)) Q:RAIMG="" D
- . S RATAIL=$S($O(^TMP($J,"RA I-TYPE",RAIMG))]"":", ",1:"")
- . I (RALUSED+$L(RAIMG)+$L(RATAIL))>RALMAX D
- .. W:RAIO !?RALDENT
- .. I RATYP="S",'$G(RAP99) S RAN=RAN+1,^TMP($J,"RAPM",RAN)=" "
- .. S RALUSED=0
- .. Q
- . W:RAIO RAIMG_RATAIL
- . I RATYP="S",'$G(RAP99) S ^TMP($J,"RAPM",RAN)=^TMP($J,"RAPM",RAN)_RAIMG_RATAIL
- . S RALUSED=RALUSED+$L(RAIMG)+$L(RATAIL)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPM2 10095 printed Jan 18, 2025@03:39:37 Page 2
- RAPM2 ;HOIFO/TH-Radiology Performance Monitors/Indicator; ;3/20/04 12:41
- +1 ;;5.0;Radiology/Nuclear Medicine;**37,44,48,63,67,99,47**;Mar 16, 1998;Build 21
- +2 ; IA 10090 allows Read w/Fileman for entire file 4
- +3 ; Supported IA #10103 reference to ^XLFDT
- +4 ; Supported IA #2056 reference to ^DIQ
- +5 ; Supported IA #2541 reference to KSP^XUPARAM
- +6 ; RVD - 3/20/09 p99
- +7 ; Print Detail report
- DETAIL ; Print Detail report
- +1 IF ($Y+5)>IOSL!(RARPT="B")
- Begin DoDot:1
- +2 IF IO=IO(0)
- IF ($EXTRACT(IOST,1,2)="C-")
- Begin DoDot:2
- +3 READ !,"Press RETURN to continue. ",X:DTIME
- End DoDot:2
- End DoDot:1
- +4 DO HDR("D")
- +5 DO PRTTOT
- +6 DO DHDR
- +7 DO DRPT
- if RAXIT
- QUIT
- +8 DO DFOOT
- +9 QUIT
- +10 ;
- PRTTOT ; Print total number of reports
- +1 SET RATOTCNT=+$GET(^TMP($JOB,"RAPM","TOTAL"))
- +2 WRITE !,"Total number of reports expected for procedures performed during specified date range: ",$JUSTIFY(RATOTCNT,$LENGTH(RATOTCNT))
- +3 QUIT
- +4 ;
- DHDR ; Header
- +1 IF ($Y+5)>IOSL
- Begin DoDot:1
- +2 SET RAPG=RAPG+1
- SET RAHD(0)="Detail Verification Timeliness Report"
- +3 WRITE @IOF,!?(RAIOM-$LENGTH(RAHD(0))\2),RAHD(0),?(RAIOM-10),"Page: ",$GET(RAPG)
- End DoDot:1
- +4 WRITE !!,?34,"Date/Time",?49,"Date/Time",?69,"Date/Time",?102,"Cat"
- +5 WRITE ?106,"Rpt",?110,"Img",?116,"Procedure"
- +6 WRITE !,"Patient Name",?17,"Case #",?34,"Registered",?49,"Transcribed",?63,"Hrs"
- +7 WRITE ?69,"Verified",?83,"Hrs",?88,"Radiologist",?102,"Exm",?106,"Sts"
- +8 WRITE ?110,"Typ",?119,"Name",!
- +9 QUIT
- +10 ;
- DRPT ; Read records
- +1 SET RAXIT=0
- +2 IF '$DATA(^TMP($JOB,"RAPM2"))
- WRITE !!?30,"No data to print...",!!!!!
- QUIT
- +3 SET D1=""
- FOR
- SET D1=$ORDER(^TMP($JOB,"RAPM2",D1))
- if D1=""
- QUIT
- if RAXIT
- QUIT
- Begin DoDot:1
- +4 SET D2=""
- FOR
- SET D2=$ORDER(^TMP($JOB,"RAPM2",D1,D2))
- if D2=""
- QUIT
- if RAXIT
- QUIT
- Begin DoDot:2
- +5 SET D3=""
- FOR
- SET D3=$ORDER(^TMP($JOB,"RAPM2",D1,D2,D3))
- if D3=""
- QUIT
- if RAXIT
- QUIT
- Begin DoDot:3
- +6 DO SRT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 QUIT
- +8 ;
- SRT ; Read records
- +1 IF RASORT="C"!(RASORT="P")
- SET RAREC=$GET(^TMP($JOB,"RAPM2",D1,D2,D3))
- DO DET
- QUIT
- +2 SET D4=""
- FOR
- SET D4=$ORDER(^TMP($JOB,"RAPM2",D1,D2,D3,D4))
- if D4=""
- QUIT
- if RAXIT
- QUIT
- Begin DoDot:1
- +3 SET RAREC=$GET(^TMP($JOB,"RAPM2",D1,D2,D3,D4))
- DO DET
- End DoDot:1
- +4 QUIT
- +5 ;
- DET ; Print detail records
- +1 ; use Transcription elasped hr for all sorts, except if sort by Verif.
- +2 SET RAVAL=$SELECT(RASORT="V":$PIECE(RAREC,U,13),1:$PIECE(RAREC,U,12))
- +3 ; remove symbols before comparison
- +4 if $EXTRACT(RAVAL)="<"
- SET RAVAL=.5
- if $EXTRACT(RAVAL)=">"
- SET RAVAL=999
- +5 ; include PENDING and those with hours > RASINCE
- +6 IF RAVAL'=""
- IF RAVAL<RASINCE
- QUIT
- +7 IF ($Y+5)>IOSL
- Begin DoDot:1
- +8 IF IO=IO(0)
- Begin DoDot:2
- +9 IF $EXTRACT(IOST,1,2)="C-"
- READ !,"Press RETURN to continue or ""^"" to exit. ",X:DTIME
- if X="^"
- SET RAXIT=1
- End DoDot:2
- +10 if RAXIT
- QUIT
- +11 DO DHDR
- End DoDot:1
- +12 if RAXIT
- QUIT
- +13 WRITE !,$EXTRACT($PIECE(RAREC,U,2),1,14)
- +14 WRITE ?16,$PIECE(RAREC,U,1)
- +15 WRITE ?33,$PIECE($$FMTE^XLFDT($PIECE(RAREC,U,3),"2FS"),":",1,2)
- +16 WRITE ?48,$PIECE($$FMTE^XLFDT($PIECE(RAREC,U,4),"2FS"),":",1,2),?63,$JUSTIFY($PIECE(RAREC,U,12),4)
- +17 WRITE ?68,$PIECE($$FMTE^XLFDT($PIECE(RAREC,U,5),"2FS"),":",1,2),?82,$JUSTIFY($PIECE(RAREC,U,13),4)
- +18 IF $PIECE(RAREC,U,6)'=""
- WRITE ?88,$EXTRACT($PIECE(RAREC,U,6),1,14)
- +19 WRITE ?104,$PIECE(RAREC,U,7),?107,$PIECE(RAREC,U,8)
- +20 WRITE ?110,$EXTRACT($PIECE(RAREC,U,9),1,3),?114,$EXTRACT($PIECE(RAREC,U,14),1,15)
- +21 if $PIECE(RAREC,U,11)=""
- WRITE ?130,"*D"
- +22 QUIT
- +23 ;
- +1 IF ($Y+5)>IOSL
- Begin DoDot:1
- +2 IF IO=IO(0)
- Begin DoDot:2
- +3 IF $EXTRACT(IOST,1,2)="C-"
- READ !,"Press RETURN to continue. ",X:DTIME
- End DoDot:2
- +4 DO DHDR
- End DoDot:1
- +5 WRITE !!,"Note: Category of Exam: 'I' for Inpatient; 'O' for Outpatient; "
- +6 WRITE "'C' for Contract; 'S' for Sharing; 'E' for Employee; 'R' for Research"
- +7 WRITE !," Report Status: 'V' for Verififed; 'R' for Released/Not "
- +8 WRITE "Verified; 'PD' for Problem Draft; 'D' for Draft"
- +9 if RANODIV
- WRITE !," *D = Division is missing"
- +10 WRITE !!?5,"* A printset, i.e., a set of multiple exams that share the same report, will be expected to have 1 report."
- +11 WRITE !!?5,"* Cancelled and ""No Credit"" cases are excluded from this report."
- +12 QUIT
- +13 ;
- STORE ; Store detail information
- +1 if RARPT="S"
- QUIT
- +2 ; for storage subscript: if no rpt dt, set to neg
- +3 SET RADHT=$SELECT(RARPTDT="":-1,1:RATDFHR)
- +4 SET RADHV=$SELECT(RAVERDT="":-1,1:RAVDFHR)
- +5 ; for display: truncate decimal portion of hours
- +6 if RATDFHR'=""
- SET RATDFHR=RATDFHR\1
- +7 if RAVDFHR'=""
- SET RAVDFHR=RAVDFHR\1
- +8 SET RATDFHR=$SELECT(RATDFHR="":"",RATDFHR<1:"<1",RATDFHR>999:">999",1:RATDFHR)
- +9 SET RAVDFHR=$SELECT(RAVDFHR="":"",RAVDFHR<1:"<1",RAVDFHR>999:">999",1:RAVDFHR)
- +10 ;
- +11 IF $$USESSAN^RAHLRU1()
- SET RAREC1=RACNDSP_U_RAPATNM_U_RADTE_U_RARPTDT_U
- +12 IF '$$USESSAN^RAHLRU1()
- SET RAREC1=RACN_U_RAPATNM_U_RADTE_U_RARPTDT_U
- +13 SET RAREC1=RAREC1_RAVERDT_U_RAPRIMNM_U_RACAT_U_RARPTST_U_RAIMGTYP_U
- +14 SET RAREC1=RAREC1_RADFN_U_RACHKDIV_U_RATDFHR_U_RAVDFHR_U_RAPRCN
- +15 ;
- +16 IF RASORT="C"
- SET ^TMP($JOB,"RAPM2",$PIECE(RADTE,"."),RACN,RAPATNM)=RAREC1
- +17 IF RASORT="P"
- SET ^TMP($JOB,"RAPM2",RAPATNM,$PIECE(RADTE,"."),RACN)=RAREC1
- +18 IF RASORT="I"
- SET ^TMP($JOB,"RAPM2",RAIMGTYP,$PIECE(RADTE,"."),RACN,RAPATNM)=RAREC1
- +19 IF RASORT="E"
- SET ^TMP($JOB,"RAPM2",RACAT,$PIECE(RADTE,"."),RACN,RAPATNM)=RAREC1
- +20 IF RASORT="R"
- SET ^TMP($JOB,"RAPM2",RAPRIMNM,$PIECE(RADTE,"."),RACN,RAPATNM)=RAREC1
- +21 IF RASORT="T"
- SET ^TMP($JOB,"RAPM2",RADHT,RADTE,RACN,RAPATNM)=RAREC1
- +22 IF RASORT="V"
- SET ^TMP($JOB,"RAPM2",RADHV,RADTE,RACN,RAPATNM)=RAREC1
- +23 QUIT
- EMAIL ; Ask if ready to email the summary report
- +1 NEW RA1
- +2 WRITE !
- SET DIR(0)="Y"
- +3 SET DIR("A")="Send summary report to local mail group ""G.RAD PERFORMANCE INDICATOR"""
- +4 SET DIR("B")="Yes"
- +5 DO ^DIR
- +6 if $DATA(DIRUT)
- QUIT
- +7 SET RAANS=Y
- +8 SET RA1=$ORDER(^RA(79,0))
- if 'RA1
- QUIT
- +9 IF '$ORDER(^RA(79,RA1,1,0))
- Begin DoDot:1
- +10 WRITE !!,?5,"No OUTLOOK mail group(s) have been entered yet."
- +11 QUIT
- End DoDot:1
- QUIT
- +12 WRITE !
- SET DIR(0)="Y"
- +13 SET DIR("A")="Send summary report to OUTLOOK mail group(s)"
- +14 SET DIR("B")="Yes"
- +15 DO ^DIR
- +16 SET RAANS2=Y
- +17 IF RAANS2
- DO CKMONTH^RAPM4
- +18 QUIT
- SEND ; Send summary report to mail group
- +1 IF RAANS=0
- IF RAANS2=0
- QUIT
- +2 NEW RA1,RA2,RASVSUB,RASVTEXT,RASTR
- +3 if $GET(RAP99)
- SET XMSUB="Radiology Timeliness Performance Reports"
- +4 if '$GET(RAP99)
- SET XMSUB="Radiology Summary Verification Timeliness"
- +5 SET XMDUZ=DUZ
- +6 SET XMTEXT="^TMP($J,""RAPM"","
- +7 SET RASVSUB=XMSUB
- SET RASVTEXT=XMTEXT
- +8 IF RAANS=1
- Begin DoDot:1
- +9 SET XMY("G.RAD PERFORMANCE INDICATOR")=""
- +10 DO ^XMD
- +11 KILL XMY
- +12 QUIT
- End DoDot:1
- +13 IF RAANS2=1
- Begin DoDot:1
- +14 SET RA1=$ORDER(^RA(79,0))
- if 'RA1
- QUIT
- +15 SET XMSUB=RASVSUB
- SET XMTEXT=RASVTEXT
- +16 SET RA2=0
- +17 ; Outlook mailgroup flagged for HQ should always get automatic mid-
- +18 ; mid-month rpt, but only get user-initiated rpt if user specifies so
- +19 ;
- +20 ; All non-HQ outlook mailgroups get all reports, including autom rpt
- +21 ;
- +22 FOR
- SET RA2=$ORDER(^RA(79,RA1,1,RA2))
- if 'RA2
- QUIT
- SET RASTR=$GET(^(RA2,0))
- Begin DoDot:2
- +23 IF $PIECE(RASTR,U,2)="Y"
- IF $GET(RAUTOM)
- SET XMY($PIECE(RASTR,U))=""
- +24 IF $PIECE(RASTR,U,2)'="Y"
- SET XMY($PIECE(RASTR,U))=""
- +25 QUIT
- End DoDot:2
- +26 if '$DATA(XMY)
- QUIT
- +27 DO ^XMD
- +28 KILL XMY
- +29 QUIT
- End DoDot:1
- +30 KILL XMDUZ
- +31 QUIT
- HDR(RATYP) ; Print appropriate header and process wait and time
- +1 if RAIO
- USE IO
- SET RAPG=$GET(RAPG)+1
- +2 IF RAPG>1!($EXTRACT(IOST,1,2)="C-")
- if RAIO
- WRITE @IOF
- +3 IF $EXTRACT(IOST,1,2)="P-"
- IF (RAPG>1)
- if RAIO
- WRITE @IOF
- +4 SET RAHD(0)=$SELECT(RATYP="S":"Summary",RATYP="D":"Detail",1:"")
- +5 SET RAHD(0)=RAHD(0)_" Verification Timeliness Report"
- +6 SET RAIOM=$SELECT(RATYP="S":80,1:IOM)
- +7 if RAIO
- WRITE !?(RAIOM-$LENGTH(RAHD(0))\2),RAHD(0),?(RAIOM-10),"Page: ",$GET(RAPG),!
- +8 IF RATYP="S"
- SET RAN=RAN+1
- Begin DoDot:1
- +9 SET ^TMP($JOB,"RAPM",RAN)=" Summary Verification Timeliness Report Page: "_$GET(RAPG)
- SET RAN=RAN+1
- +10 SET ^TMP($JOB,"RAPM",RAN)=""
- SET RAN=RAN+1
- End DoDot:1
- +11 ;
- +12 ;added by p99
- if '$GET(DUZ(2))
- SET DUZ(2)=$$KSP^XUPARAM("INST")
- +13 DO GETS^DIQ(4,DUZ(2),".01;14*;99","E","RAR","RAMSG")
- +14 KILL X
- +15 ; Name of facility
- SET X(1)=RAR(4,DUZ(2)_",",.01,"E")
- +16 ; Station Number
- SET X(2)=RAR(4,DUZ(2)_",",99,"E")
- +17 IF $DATA(RAR(4.014))
- Begin DoDot:1
- +18 ; Association
- SET X(3)=RAR(4.014,"1,"_DUZ(2)_",",.01,"E")
- +19 ; Parent of Association
- SET X(4)=RAR(4.014,"1,"_DUZ(2)_",",1,"E")
- +20 ; should be VISN number
- SET X(5)=$SELECT(X(3)="VISN":X(4),1:"")
- End DoDot:1
- +21 IF '$TEST
- SET X(5)=""
- +22 ;
- +23 if RAIO
- WRITE !,"Facility: ",X(1),?41,"Station: ",X(2),?60,"VISN: ",X(5)
- +24 IF RATYP="S"
- Begin DoDot:1
- +25 SET $PIECE(X(6)," ",79)=""
- +26 SET $EXTRACT(X(6),1,(10+$LENGTH(X(1))))="Facility: "_X(1)
- +27 SET $EXTRACT(X(6),41,(50+$LENGTH(X(2))))="Station: "_X(2)
- +28 SET $EXTRACT(X(6),60,(66+$LENGTH(X(5))))="VISN: "_X(5)
- +29 SET ^TMP($JOB,"RAPM",RAN)=X(6)
- +30 SET RAN=RAN+1
- +31 QUIT
- End DoDot:1
- +32 WRITE !,"Division: "
- +33 IF RATYP="S"
- SET ^TMP($JOB,"RAPM",RAN)="Division: "
- +34 DO DIV
- +35 if (RATYP="S")
- SET RAN=RAN+1
- +36 ;
- +37 if RAIO
- WRITE !,"Exam Date Range: "
- +38 if RAIO
- WRITE $$FMTE^XLFDT(RABDATE,"2D")," - ",$$FMTE^XLFDT(RAEDATE,"2D")
- +39 IF RATYP="S"
- Begin DoDot:1
- +40 if '$GET(RAP99)
- SET ^TMP($JOB,"RAPM",RAN)=""
- +41 SET RAN=RAN+1
- SET ^TMP($JOB,"RAPM",RAN)="Exam Date Range: "_$$FMTE^XLFDT(RABDATE,"2D")_" - "_$$FMTE^XLFDT(RAEDATE,"2D")_" "
- SET RAN=RAN+1
- End DoDot:1
- +42 ;
- +43 if RAIO
- WRITE !,"Imaging Type(s): "
- +44 IF RATYP="S"
- IF '$GET(RAP99)
- SET RAN=RAN+1
- SET ^TMP($JOB,"RAPM",RAN)=""
- SET RAN=RAN+1
- SET ^TMP($JOB,"RAPM",RAN)="Imaging Type(s): "
- +45 DO IMG
- +46 if RATYP="S"
- SET RAN=RAN+1
- +47 ;
- +48 ; Run date and time
- +49 SET NOW=$$NOW^XLFDT
- SET NOW=$PIECE(NOW,".",1)_"."_$EXTRACT($PIECE(NOW,".",2),1,4)
- +50 if RAIO
- WRITE !,"Run Date/Time: ",$$FMTE^XLFDT(NOW,"2P"),!
- +51 IF RATYP="S"
- SET RAN=RAN+1
- SET ^TMP($JOB,"RAPM",RAN)="Run Date/Time: "_$$FMTE^XLFDT(NOW,"2P")
- SET RAN=RAN+1
- +52 IF RARAD
- Begin DoDot:1
- +53 if RAIO
- WRITE !,"Primary Interpreting Staff Physician: ",$$GET1^DIQ(200,RARAD,.01),!
- +54 IF RATYP="S"
- Begin DoDot:2
- +55 SET ^TMP($JOB,"RAPM",RAN)=""
- SET RAN=RAN+1
- +56 SET ^TMP($JOB,"RAPM",RAN)="Primary Interpreting Staff Physician: "_$$GET1^DIQ(200,RARAD,.01)
- SET RAN=RAN+1
- +57 QUIT
- End DoDot:2
- +58 QUIT
- End DoDot:1
- +59 IF (RARPT="D"!(RARPT="B"))
- IF (RATYP'="S")
- Begin DoDot:1
- +60 SET RASRT=$SELECT(RASORT="C":"Case Number",RASORT="E":"Category of Exam",RASORT="I":"Imaging Type",RASORT="P":"Patient Name",RASORT="R":"Radiologist",RASORT="T":"Hrs to Transcription",RASORT="V":"Hrs to Verification",1:"")
- +61 if RAIO
- WRITE !,"Sorted by: ",RASRT,?45,"Min. hours elasped to "_$SELECT(RASORT="V":"Verification",1:"Transcription")_": "_RASINCE
- End DoDot:1
- +62 QUIT
- DIV ; List selected Division
- +1 if '$DATA(^TMP($JOB,"RA D-TYPE"))
- QUIT
- +2 SET RADIV=""
- FOR I=1:1
- SET RADIV=$ORDER(^TMP($JOB,"RA D-TYPE",RADIV))
- if RADIV=""
- QUIT
- Begin DoDot:1
- +3 IF $X'>(RAIOM-$LENGTH("Division(s): "))
- Begin DoDot:2
- +4 if RAIO
- WRITE RADIV_$SELECT($ORDER(^TMP($JOB,"RA D-TYPE",RADIV))]"":", ",1:"")
- +5 IF RATYP="S"
- SET ^TMP($JOB,"RAPM",RAN)=^TMP($JOB,"RAPM",RAN)_RADIV_$SELECT($ORDER(^TMP($JOB,"RA D-TYPE",RADIV))]"":", ",1:"")
- End DoDot:2
- +6 IF $X>(RAIOM-$LENGTH("Division(s): "))
- Begin DoDot:2
- +7 if RAIO
- WRITE !?($X+$LENGTH("Division(s): "))
- +8 IF RATYP="S"
- if '$GET(RAP99)
- SET RAN=RAN+1
- SET ^TMP($JOB,"RAPM",RAN)=" "
- End DoDot:2
- End DoDot:1
- +9 QUIT
- IMG ; List selected Imaging Type(s)
- +1 if '$DATA(^TMP($JOB,"RA I-TYPE"))
- QUIT
- +2 ;N RALMAX,RALUSED,RATAIL,RALDENT
- +3 SET RALDENT=$LENGTH("Imaging Type(s): ")
- +4 SET RALMAX=RAIOM-RALDENT
- +5 SET RALUSED=0
- +6 SET RAIMG=""
- FOR J=1:1
- SET RAIMG=$ORDER(^TMP($JOB,"RA I-TYPE",RAIMG))
- if RAIMG=""
- QUIT
- Begin DoDot:1
- +7 SET RATAIL=$SELECT($ORDER(^TMP($JOB,"RA I-TYPE",RAIMG))]"":", ",1:"")
- +8 IF (RALUSED+$LENGTH(RAIMG)+$LENGTH(RATAIL))>RALMAX
- Begin DoDot:2
- +9 if RAIO
- WRITE !?RALDENT
- +10 IF RATYP="S"
- IF '$GET(RAP99)
- SET RAN=RAN+1
- SET ^TMP($JOB,"RAPM",RAN)=" "
- +11 SET RALUSED=0
- +12 QUIT
- End DoDot:2
- +13 if RAIO
- WRITE RAIMG_RATAIL
- +14 IF RATYP="S"
- IF '$GET(RAP99)
- SET ^TMP($JOB,"RAPM",RAN)=^TMP($JOB,"RAPM",RAN)_RAIMG_RATAIL
- +15 SET RALUSED=RALUSED+$LENGTH(RAIMG)+$LENGTH(RATAIL)
- End DoDot:1
- +16 QUIT