245 lines
9.0 KiB
Mathematica
245 lines
9.0 KiB
Mathematica
RAPM2 ;HOIFO/TH-Radiology Performance Monitors/Indicator; ;2/26/04 12:41
|
|
;;5.0;Radiology/Nuclear Medicine;**37,44,48,63,67**;Mar 16, 1998
|
|
; IA 10090 allows Read w/Fileman for entire file 4
|
|
; 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 !!,?32,"Date/Time",?48,"Date/Time",?68,"Date/Time",?102,"Cat"
|
|
W ?106,"Rpt",?110,"Img",?116,"Procedure"
|
|
W !,"Patient Name",?18,"Case #",?32,"Registered",?48,"Transcribed",?62,"Hrs"
|
|
W ?68,"Verified",?82,"Hrs",?87,"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,15)
|
|
W ?17,$P(RAREC,U,1)
|
|
W ?31,$P($$FMTE^XLFDT($P(RAREC,U,3),"2FS"),":",1,2)
|
|
W ?46,$P($$FMTE^XLFDT($P(RAREC,U,4),"2FS"),":",1,2),?61,$J($P(RAREC,U,12),4)
|
|
W ?66,$P($$FMTE^XLFDT($P(RAREC,U,5),"2FS"),":",1,2),?81,$J($P(RAREC,U,13),4)
|
|
I $P(RAREC,U,6)'="" W ?86,$E($P(RAREC,U,6),1,16)
|
|
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
|
|
;
|
|
DFOOT ; Footer for Detail report
|
|
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)
|
|
;
|
|
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 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
|
|
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=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
|
|
;
|
|
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" S ^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" S ^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 ^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 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" S RAN=RAN+1,^TMP($J,"RAPM",RAN)=" "
|
|
.. S RALUSED=0
|
|
.. Q
|
|
. W:RAIO RAIMG_RATAIL
|
|
. I RATYP="S" S ^TMP($J,"RAPM",RAN)=^TMP($J,"RAPM",RAN)_RAIMG_RATAIL
|
|
. S RALUSED=RALUSED+$L(RAIMG)+$L(RATAIL)
|
|
Q
|