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

RAPM.m

Go to the documentation of this file.
  1. RAPM ;HOIFO/TH-Radiology Performance Monitors/Indicator; ;5/12/04 10:03
  1. ;;5.0;Radiology/Nuclear Medicine;**37,44,48,67,99,47**;Mar 16, 1998;Build 21
  1. ;RVD - 3/19/09 p99.
  1. ;Supported IA #2056 reference to ^DIQ
  1. ;Supported IA #10000 reference to C^%DTC
  1. ;Supported IA #10090 reference to ^DIC(4
  1. ; *** Application variables: ***
  1. ;
  1. ; Exam Date - RADTE (Regular Fileman format)
  1. ; RADTI (Inverse Fileman format)
  1. ; Case Number - RACN Exam Status - RAEXST
  1. ; Category of Exam - RACAT Primary Interpreting Staff - RAPRIM
  1. ; Date Report Entered - RARPTDT Verified Date - RAVERDT
  1. ; Report Status - RARPTST Page Number - RAPG
  1. ; Type of Report - RARPT
  1. ; Internal number of an entry in the Patient file (#2) - RADFN
  1. ;
  1. INIT ; Check for the existence of RACESS. Pass in user's DUZ!
  1. I $D(DUZ),($O(RACCESS(DUZ,""))']"") D CHECK^RADLQ3(DUZ)
  1. ;
  1. N DIR,DIRUT,RABDATE,RAEDATE,RARPT,DTDIFF,RABEGDT,RAENDDT,RA1
  1. N RAM,RARAD,RAR,RAMSG,X,Y K RAP99
  1. S (RABDATE,RAEDATE,RAANS,RAANS2,RANODIV,RASINCE,RARAD)="",RAN=0
  1. ; RANODIV=1 if one or more exams are missing DIVISION
  1. PROMPT ;
  1. W @IOF
  1. W !!,"Radiology Verification Timeliness Report",!!
  1. ; Prompt for Report Type. Quit if no report type selected
  1. D GETRPT K DIR Q:$D(DIRUT)
  1. ; Prompt for Date Range - Quit if no dates selected
  1. W !! D GETDATE K DIR Q:$D(DIRUT)
  1. ; Prompt for Radiologist if Short or Both
  1. D RADIOL^RAPM3
  1. ; Prompt for Division and Imaging Types
  1. S X=$$DIVLOC^RAUTL7() I X G EXIT
  1. I $D(^TMP($J,"RA I-TYPE","VASCULAR LAB")) D
  1. . K ^TMP($J,"RA I-TYPE","VASCULAR LAB")
  1. . W !!?5,"*** Imaging type 'Vascular Lab' will not be included in this report ***"
  1. ; Prompt for sort option if Detail
  1. D:RARPT'="S" SORT K DIR Q:$D(DIRUT)
  1. ; Prompt for mail delivery if Short or Both
  1. I RARPT'="D" D EMAIL^RAPM2 K DIR Q:$D(DIRUT)
  1. ; Warning for Detail or Both
  1. I RARPT="D"!(RARPT="B") D
  1. . S RATXT="*** The detail report requires a 132 column output device ***"
  1. . S RALINE="",$P(RALINE,"*",$L(RATXT))=""
  1. . W !!?(80-$L(RATXT)\2),RALINE,!?(80-$L(RATXT)\2),RATXT,!?(80-$L(RATXT)\2),RALINE,!
  1. .Q
  1. D DEV
  1. I RAPOP D G EXIT
  1. . I RAANS!(RAANS2) W !?5,"** No mail will be sent **",$C(7)
  1. . Q
  1. START ; Get data and print the report
  1. S:$D(ZTQUEUED) ZTREQ="@" S RAIO=$S(IO="":0,1:1),RAN=0
  1. ;added by patch #99
  1. D GETDATA
  1. I $G(RAP99) S RAS99=1 D PWT^RAPMW(RABDATE,RAEDATE) ;process partial Wait and Time report
  1. ;
  1. ;D GETDATA
  1. I RARPT="S"!(RARPT="B") S RAPG=0 D ^RAPM1
  1. I RARPT="D"!(RARPT="B") S RAPG=0 D ^RAPM2
  1. I $G(RAP99) K RAS99 S RAL99=1 D PWT^RAPMW(RABDATE,RAEDATE) ;process all wait and time reports
  1. ; see if need send email
  1. D SEND^RAPM2
  1. D EXIT
  1. Q
  1. ;
  1. GETRPT ; Prompt for Summary or Detail or Both reports; Default = Summary Report
  1. W !,"Enter Report Type"
  1. S DIR(0)="S^S:Summary;D:Detail;B:Both"
  1. S DIR("A")="Select Report Type",DIR("B")="S"
  1. S DIR("?")="Enter Summary report OR Detail report OR Both reports"
  1. D ^DIR
  1. Q:$D(DIRUT)
  1. S RARPT=Y
  1. Q
  1. GETDATE ; Prompt for start and end dates
  1. S DIR(0)="D^:"_DT_":AEX"
  1. I RARPT'="D" D
  1. . W !!?4,"The begin date for Summary and Both must be at least 10 days before today.",!
  1. . S X1=DT,X2=-10 D C^%DTC S RA1=X
  1. . S DIR(0)="D^:"_RA1_":AEX"
  1. . Q
  1. S DIR("A")="Enter starting date"
  1. S DIR("?")="Enter date to begin searching from"
  1. D ^DIR
  1. Q:$D(DIRUT)
  1. S RABDATE=Y
  1. ;
  1. S RADD=91,X1=RABDATE,X2=RADD D C^%DTC S RAMAXDT=X
  1. ; put 10 day block for summary report or Both
  1. I RARPT'="D" D
  1. . W !!?4,"The ending date for Summary and Both must be at least 10 days before today.",!
  1. . S X1=DT,X2=-10 D C^%DTC S:X<RAMAXDT RAMAXDT=X
  1. S:RAMAXDT>DT RAMAXDT=DT
  1. S DIR(0)="D^"_RABDATE_":"_RAMAXDT_":AE"
  1. S DIR("A")="Enter ending date"
  1. S DIR("?",1)=" +91 days max. for Summary and Detail."
  1. S DIR("?",2)=" And the ending date for the Summary and Both"
  1. S DIR("?")=" must be at least 10 days before today."
  1. D ^DIR
  1. Q:$D(DIRUT)
  1. ;
  1. ; Set end date to end of day
  1. ; RABDATE and RAEDATE are original values
  1. ; RABEGDT and RAENDDT are used in GETDATA
  1. S RAEDATE=Y,RAENDDT=RAEDATE_.9999
  1. ; Set start date back to include current day
  1. S RABEGDT=(RABDATE-1)_.9999
  1. Q
  1. SORT ; Prompt for Sorted by
  1. W !!,"Sort report by"
  1. S DIR(0)="S^C:Case Number;E:Category of Exam;I:Imaging Type;P:Patient Name;R:Radiologist;T:Hrs to Transcrip.;V:Hrs to Verif."
  1. S DIR("A")="Select Sorted by",DIR("B")="C"
  1. D ^DIR
  1. Q:$D(DIRUT)
  1. S RASORT=Y
  1. S DIR(0)="N^0:240"
  1. S DIR("A")="Print PENDING and "_$S(RASORT="V":"Verif.",1:"Transrip.")_" hours greater than or equal to"
  1. S DIR("B")="72"
  1. S DIR("?")="Enter minimum number of hours elapsed since registration."
  1. D ^DIR Q:$D(DIRUT) S RASINCE=Y
  1. Q
  1. DEV ; Device
  1. I $D(DIRUT) D EXIT Q
  1. W:RARPT="B" !!,"Specify device for both summary and detail reports."
  1. D TASK
  1. D ZIS^RAUTL
  1. Q
  1. TASK ; set vars for taskman
  1. S ZTRTN="START^RAPM"
  1. S ZTSAVE("RA*")=""
  1. S ZTSAVE("^TMP($J,")=""
  1. ;S ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
  1. ;S ZTSAVE("^TMP($J,""RA I-TYPE"",")=""
  1. S:$G(RAP99) ZTDESC="Radiology Timeliness Performance Reports"
  1. S:'$G(RAP99) ZTDESC="Radiology Verification Timeliness Report"
  1. Q
  1. ;
  1. GETDATA ; Get all the data
  1. ; Order thru Exam Date (RADTE)
  1. S RADTE=RABEGDT F S RADTE=$O(^RADPT("AR",RADTE)) Q:'RADTE Q:(RADTE>RAENDDT) D
  1. . S RADFN="" F S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:'RADFN D
  1. . . ; Get patient name
  1. . . S RAPATNM=$$GET1^DIQ(2,RADFN,.01) S:RAPATNM="" RAPATNM=" "
  1. . . ; Order thru inverse Exam Date (RADTI)
  1. . . S RADTI="" F S RADTI=$O(^RADPT("AR",RADTE,RADFN,RADTI)) Q:'RADTI D CHECK
  1. . . Q
  1. . Q
  1. Q
  1. CHECK ; Check type of image
  1. Q:'$D(^RADPT(RADFN,"DT",RADTI)) ;no exam data at all
  1. S RAITYP=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2)
  1. S RAIMGTYP=$P($G(^RA(79.2,+RAITYP,0)),U,1)
  1. ; quit if img typ is known AND does not match selection
  1. I RAIMGTYP'="",'$D(^TMP($J,"RA I-TYPE",RAIMGTYP)) Q
  1. I RAIMGTYP="" S RAIMGTYP="(unknown)"
  1. ;
  1. ; Check division - Quit if no division selected
  1. S RASELDIV=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,3)
  1. S RACHKDIV=$P($G(^DIC(4,+RASELDIV,0)),U,1)
  1. ; quit if div is known AND does not match selection
  1. I RACHKDIV'="",'$D(^TMP($J,"RA D-TYPE",RACHKDIV)) Q
  1. S:RACHKDIV="" RANODIV=1
  1. ;
  1. ; Get exam related data
  1. S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D
  1. . S (RACN0,RAEXST,RANUM,RACN,RAPRIM,RAPRIMNM,RACAT,RARPTTXT)=""
  1. . S (RARPTDT,RAVERDT,RARPTST,RADHT,RADHV,RATDFHR,RAVDFHR)=""
  1. . ; Get 0 node (RACN0) of ^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
  1. . S RACN0=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. . Q:RACN0="" ; no exam data
  1. . ; Get Case number: Exam Date - Case Number
  1. . S RACN=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_$P(RACN0,U,1)
  1. . N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
  1. . S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
  1. . ; Get exam status
  1. . S RAEXST=$P(RACN0,U,3)
  1. . Q:RAEXST="" ; no exam status
  1. . ; Quit if exam's CREDIT METHOD is 2 = no credit
  1. . Q:$P(RACN0,U,26)=2
  1. . ; Quit if exam status is "Cancelled"
  1. . I $P(^RA(72,RAEXST,0),U,3)=0 Q
  1. . ; Get number of set - '1' separate; '2' for combined report.
  1. . S RANUM=$P(RACN0,U,25)
  1. . ; if member of set > 1 then set RACNI to 99999 to skip remaining cases
  1. . I RANUM>1 S RACNI=99999
  1. . ; Get Radiologist (Primary Interpreting Staff) internal # and name.
  1. . S RAPRIM=$P(RACN0,U,15)
  1. . ; if specific radiologist requested, quit if not his/her case
  1. . I RARAD,RAPRIM'=RARAD Q
  1. . S RAPRIMNM=$$GET1^DIQ(200,RAPRIM,.01) S:RAPRIMNM="" RAPRIMNM=" "
  1. . ; Get Category of Exam
  1. . S RACAT=$P(RACN0,U,4)
  1. . ; Get Procedure Name
  1. . S RAPRCN=$P($G(^RAMIS(71,+$P(RACN0,U,2),0)),U)
  1. . ; Get IEN of imaging report
  1. . S RARPTTXT=$P(RACN0,U,17)
  1. . ; Pending if no imaging report OR report doesn't exist in the Report
  1. . ; file (#74) OR Stub report
  1. . S RAHASR=0 ;=1 has real report
  1. . I $D(^RARPT(+RARPTTXT,0)),'$$STUB^RAEDCN1(+RARPTTXT) S RAHASR=1
  1. . I 'RAHASR D
  1. . . S ^TMP($J,"RAPM","TR",0)=$G(^TMP($J,"RAPM","TR",0))+1
  1. . . S ^TMP($J,"RAPM","VR",0)=$G(^TMP($J,"RAPM","VR",0))+1
  1. . ; Get report info. if real report exists.
  1. . I RAHASR D RPTINFO^RAPM1
  1. . D STORE^RAPM2
  1. . ; Calculate the total number of reports
  1. . S ^TMP($J,"RAPM","TOTAL")=$G(^TMP($J,"RAPM","TOTAL"))+1
  1. Q
  1. EXIT ; Exit
  1. ; Close device
  1. D CLOSE^RAUTL
  1. K RACN0,RAEXST,RANUM,RACN,RAPRIM,RAPRIMNM,RACAT,RARPTTXT,RAANS,RATXT
  1. K DIR,DIRUT,RABDATE,RAEDATE,RARPT,DTDIFF,RABEGDT,RAENDDT,RAITYP,RAIMGTYP,RATYP
  1. K ZTRTN,ZTSAVE,ZTDESC,RAPG,RASELDIV,RACHKDIV,RACNO,RAVHRS,RACNDSP,RASSAN
  1. K RADIV,RAN,RAIMG,RAREC1,RATOTCNT,RACNI,RADFN,RADTE,RADTI,RAHD,RAPATNM
  1. K RAPOP,RAPSTX,RAQUIT,RAREC,RARPTDT,RARPTST,RASORT,RASRT,RATDFHR,RAHASR
  1. K RATDFSEC,RATHRS,RAVDFHR,RAVDFSEC,RAVERDT,RAMES,RALINE,RAMAXDT,RADD
  1. K RAANS2,RAIOM,RAHDR,RANODIV,RASINCE,RADHT,RADHV,RAVAL,RAPRCN
  1. K RAXIT,RAIO,RALDENT,RALMAX,RALUSED,RATAIL,RAS99,RAL99,RAP99,RAN
  1. K ^TMP($J)
  1. Q