Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAPM2

RAPM2.m

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