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

RAPMW2.m

Go to the documentation of this file. 
  1. RAPMW2 ;HOIFO/SWM-Radiology Wait Time reports ;12/05/05 13:41
  1.  ;;5.0;Radiology/Nuclear Medicine;**67,79,83,99,47**;Mar 16, 1998;Build 21
  1.  ; IA 10063 allows check for Task Stop Request
  1.  ; detail
  1.  Q
  1. STORDET ;
  1.  S RAREC=""
  1.  S RACNL=$E(RAXDT,4,5)_$E(RAXDT,6,7)_$E(RAXDT,2,3)_"-"_+RACN0 ;long CN
  1.  N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
  1.  S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACNL)
  1.  S RA71REC=$G(^RAMIS(71,+$P(RACN0,U,2),0))
  1.  S RAXMST=$P(RA72,U) ;exam status name
  1.  S RACPT=$P($$NAMCODE^RACPTMSC($P(RA71REC,U,9),RAXDT),U) ;CPT code
  1.  S RAPROCNM=$P(RA71REC,U) ;procedure name
  1.  S RAPATNM=$$GET1^DIQ(2,RADFN,.01) S:RAPATNM="" RAPATNM=" " ;pt.name
  1.  S RAPATNM=$E(RAPATNM,1,12) ;use 1st 12 chars of pat name
  1.  S RAPATND=RAPATNM_"-"_RADFN ;patname-DFN
  1.  S RADTORD=$P($P(RAOREC,U,16),".") ;date ordered
  1.  ; store items in this order -- piece no.;field descrp/
  1.  ; 1;pt.name/ 2;long case no./ 3;dt ordered/ 4;dt desired/ 5;exam dt/
  1.  ; 6;no. days wait/ 7;exm stat name/ 8;CPT code/ 9; proc name/
  1.  ; 10;img typ name/ 11;* if canc & re-ord same day/ 12;Proc Typ Name/
  1.  ; 13;"p" if case from print set (highest ranked proc type)
  1.  ;
  1.  I $$USESSAN^RAHLRU1() S RAREC=RAPATNM_U_RACNDSP_U_$E(RADTORD,1,7)_U_$E(RADSDT,1,7)
  1.  I '$$USESSAN^RAHLRU1() S RAREC=RAPATNM_U_RACNL_U_$E(RADTORD,1,7)_U_$E(RADSDT,1,7)
  1.  S RAREC=RAREC_U_$E(RAXDT,1,7)_U_RAWAITD_U_$E(RAXMST,1,11)_U_RACPT
  1.  S RAREC=RAREC_U_$E(RAPROCNM,1,45)_U_$E(RAIMGTYP,1,3)_U_$S(RASAME2:"*",1:"")_U_RAPTA
  1.  S RAREC=RAREC_U_$S(RACNI=99999:"p",1:"") ;flag printset case picked
  1.  ; subscript 3 is the sort value
  1.  ; subscripts 4-6 combined should be unique to a case, prevent over-
  1.  ;    writing subscript 3 when >1 case has same sort value 
  1.  ; subscript 4 is the exam date in Fileman notation
  1.  ; subcript 5 is the patient name (1st 12 chars) and DFN
  1.  ; subscript 6 is the "P" level ien of file 70
  1.  I RASORT="CN" S ^TMP($J,"RA WAIT3",RACNL,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="CPT" S ^TMP($J,"RA WAIT3",RACPT,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="DD" S ^TMP($J,"RA WAIT3",RADSDT,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="D" S ^TMP($J,"RA WAIT3",RAWAITD,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="DO" S ^TMP($J,"RA WAIT3",RADTORD,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="DR" S ^TMP($J,"RA WAIT3",RAXDT,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="I" S ^TMP($J,"RA WAIT3",RAIMGTYP,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="PT" S ^TMP($J,"RA WAIT3",RAPTA,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="PN" S ^TMP($J,"RA WAIT3",RAPATNM,RADTE,RAPATND,RACNISAV)=RAREC
  1.  I RASORT="PROC" S ^TMP($J,"RA WAIT3",RAPROCNM,RADTE,RAPATND,RACNISAV)=RAREC
  1.  Q
  1. WRTDET ;
  1.  S RAHD0="Detail",RAPG=1
  1.  D SETHD^RAPMW1
  1.  D PRTD Q:RAXIT
  1.  D FOOTD
  1.  Q
  1. HDDET ;
  1.  W !!,"Sorted by: ",RASORTNM,?38,"Print only cases with minimum Days Wait of: ",RASINCE
  1.  W !,"Total number of procedures registered during specified exam date range: ",RATOTAL
  1.  Q
  1. COLHDD ;
  1.  I RAPG>1 W @IOF,!,"Page: ",RAPG
  1.  S RAPG=RAPG+1
  1.  W !!?31,"Date",?40,"Date",?49,"Date",?58,"Days",?63,"Exam",?75,"CPT",?123,"Img",?127,"PROC."
  1.  W !,"Patient Name",?14,"Case #",?31,"Ordered",?40,"Desired",?49,"Register",?58,"Wait",?63,"Status",?75,"Code",?81,"Name of Procedure",?123,"Typ",?127,"TYPE"
  1.  W !,$E(RADASH,1,12),?14,$E(RADASH,1,16),?31,$E(RADASH,1,8),?40,$E(RADASH,1,8),?49,$E(RADASH,1,8),?58,$E(RADASH,1,4),?63,$E(RADASH,1,11),?75,$E(RADASH,1,5),?81,$E(RADASH,1,41),?123,$E(RADASH,1,3),?127,$E(RADASH,1,5)
  1.  I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1 ;user stopped task
  1.  Q
  1. PRTD ;
  1.  I RATYP="B" D PRESS^RAPMW1 Q:RAXIT
  1.  N X
  1.  D HD^RAPMW1 Q:RAXIT  D HDDET,COLHDD
  1.  S RA0="",RAXIT=0
  1.  F  S RA0=$O(^TMP($J,"RA WAIT3",RA0)) Q:RA0=""  Q:RAXIT  S RA1=0 D
  1.  .F  S RA1=$O(^TMP($J,"RA WAIT3",RA0,RA1)) Q:'RA1  Q:RAXIT  S RA2=0 D
  1.  ..F  S RA2=$O(^TMP($J,"RA WAIT3",RA0,RA1,RA2)) Q:RA2=""  Q:RAXIT  S RA3=0 D
  1.  ...F  S RA3=$O(^TMP($J,"RA WAIT3",RA0,RA1,RA2,RA3)) Q:'RA3  Q:RAXIT  S X=^(RA3) D
  1.  ....D CKLINE Q:RAXIT
  1.  ....W !,$P(X,U),?13,$P(X,U,13),?14,$P(X,U,2),?31,$$FMTE^XLFDT($P(X,U,3),2),?40,$$FMTE^XLFDT($P(X,U,4),2),?49,$$FMTE^XLFDT($P(X,U,5),2),$P(X,U,11),?58,$J($P(X,U,6),4),?63,$P(X,U,7)
  1.  ....W ?75,$P(X,U,8),?81,$P(X,U,9),?123,$P(X,U,10),?127,$E($P(X,U,12),1,5)
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  Q
  1. CKLINE ;
  1.  I ($Y+5)>IOSL D
  1.  . S RAXIT=$$S^%ZTLOAD("This task was in routine RAPMW2 when it was stopped.") I RAXIT S ZTSTOP=1 Q  ;IA10063
  1.  .D PRESS^RAPMW1
  1.  .Q:RAXIT
  1.  .D COLHDD
  1.  .Q
  1.  Q
  1. FOOTD ;
  1.  D PRESS^RAPMW1 Q:RAXIT  W:$E(IOST,1,2)="C-" @IOF
  1.  I RANEG W !!?3,"(There ",$S(RANEG=1:"is",1:"are")," ",RANEG," case",$S(RANEG=1:"",1:"s")," with negative days wait included in the listing.)",!
  1.  F I=1:1:28 Q:RAXIT  W !?4,$P($T(FOOTD2+I),";;",2) I ($Y+5)>IOSL D PRESS^RAPMW1 Q:RAXIT  W:$E(IOST,1,2)="C-" @IOF
  1.  Q
  1. CALC ;
  1.  S RASAME2=0 ;=1 if exm's order was cancelled & reordered same day
  1.  S RAORIEN=$P(RACN0,U,11)
  1.  S RAOREC=$G(^RAO(75.1,+RAORIEN,0))
  1.  I RAOREC="" S ^TMP($J,"RA WAIT NO ORD",RADFN,RADTI,RACNI)=RAORIEN Q
  1.  S RAXDT=9999999.9999-RADTI ; exam date FM format
  1.  S RADSDT=$P(RAOREC,U,21) ; Date Desired
  1.  I RADSDT="" S ^TMP($J,"RA WAIT NO DSR DT",RADFN,RADTI,RACNI)=RAORIEN Q
  1.  S RAWAITD=$$FMDIFF^XLFDT(RAXDT,RADSDT) ;Wait days btw exm & desired dt
  1.  S:RAWAITD<0 RANEG=RANEG+1
  1.  D STORSUM^RAPMW1 ;store summary counts for Summary, Detail, Both
  1.  S RA16=$P(RAOREC,U,16) ; request entered dt/tm
  1.  ; count if same proc cancelled and reordered same day
  1.  S RA1=$E(RA16,1,7)
  1.  ; loop start w Last Activity same date as order's entry date
  1.  F  S RA1=$O(^RAO(75.1,"AO",RA1)) Q:'RA1  Q:RA1>RA16  D
  1.  .S RA2=0  F  S RA2=$O(^RAO(75.1,"AO",RA1,RA2)) Q:'RA2  Q:RA2=RAORIEN  D
  1.  ..S RA3=^RAO(75.1,RA2,0) ;skip exm's order
  1.  ..; other order is discontinued,same patient,same ordered procedure
  1.  ..I $P(RA3,U,5)=1,$P(RA3,U,1)=RADFN,$P(RA3,U,2)=$P(RAOREC,U,2) S RASAME=RASAME+1,RASAME2=1
  1.  ..Q
  1.  .Q
  1.  ; store detail rows for Detail,Both IF days wait at least = RASINCE
  1.  I "B^D"[RATYP,((RAWAITD<0)!(RAWAITD'<RASINCE)) D STORDET
  1.  Q
  1. PTA ; *79
  1.  S RAPRC=$P(RACN0,U,2)
  1.  I RAPRC="" S RAPTA="unknown" Q
  1.  S RACPTI=+$P($G(^RAMIS(71,+RAPRC,0)),U,9)
  1.  S RACPTC=$P($$NAMCODE^RACPTMSC(RACPTI,DT),U)
  1.  S RAPTA=$S(RACPTI:$O(^RA(73.2,"B",RACPTC,0)),1:"")
  1.  S RAPTA=$P($G(^RA(73.2,+RAPTA,0)),U,2)
  1.  S RAPTA=$S(RAPTA="":"unknown",'$D(RACOL(RAPTA)):"unknown",1:RAPTA)
  1.  ; RAPTA should match one of the RATOTAL(rapta)
  1.  Q
  1. COLHDS(X) ; moved from RAPMW1
  1.  ;input: X (header) 1 = DAYS WAIT -- PERCENTAGES; 2 = DAYS WAIT -- COUNTS
  1.  I X=1 D
  1.  .W !,"PROCEDURE",?29,"<=14",?37,"<=30",?45,"31-60",?54,"61-90",?63,"91-120",?73,">120"
  1.  .W !,"TYPE",?29,"Days",?37,"Days",?46,"Days",?55,"Days",?65,"Days",?73,"Days"
  1.  .W !,"------------------------",?27,"------",?35,"------",?44,"------",?53,"------",?63,"------",?71,"------"
  1.  .Q
  1.  I X=2 D
  1.  .W !,"PROCEDURE",?19,"<=14",?27,"<=30",?34,"31-60",?42,"61-90",?49,"91-120",?59,">120",?68,"ROW",?75,"Avg."
  1.  .W !,"TYPE",?19,"Days",?27,"Days",?35,"Days",?43,"Days",?51,"Days",?59,"Days",?66,"TOTAL",?75,"Days"
  1.  .W !,"---------------",?16,"-------",?24,"-------",?32,"-------",?40,"-------",?48,"-------",?56,"-------",?64,"-------",?72,"-------"
  1.  .Q
  1.  Q
  1. FOOTD2 ;
  1.  ;;
  1.  ;;1. Cancelled, "No Credit", inpatient cases, and not the highest modality of a printset are excluded from this report.
  1.  ;;   (See 3. below.)
  1.  ;;
  1.  ;;2. The "Days Wait" represent # of days from the Registered date (the date/time entered at the "Imaging Exam Date/Time:" prompt)
  1.  ;;   backwards to the Date Desired for the ordered procedure.  The calculation is based on the number of different days and 
  1.  ;;   not rounded off by hours.
  1.  ;;
  1.  ;;3. If the user did not select a specific CPT Code or Procedure Name, then the cases from a printset (group of cases that 
  1.  ;;   share the same report) will have only the case with the highest ranked modality printed.  Modalities are ranked 
  1.  ;;   in this order, (1) being the highest:
  1.  ;;   (1) Interventional, (2) MRI, (3) CT, (4) Cardiac Stress test, (5) Nuc Med, (6) US, (7) Mammo, (8) General Rad (9) Other
  1.  ;;   However, all the cases from an examset (group of cases that have separate reports) will all be listed.
  1.  ;;
  1.  ;;4. "Procedure Types" are assigned by a national CPT code look-up table and may differ from locally defined "Imaging Types."  
  1.  ;;   Therefore the number of procedures in each category may not be the same as other radiology management reports.
  1.  ;;
  1.  ;;5. Procedure Type of "unknown" refers to either cases that have no matching procedure type in the spreadsheet of CPT Codes
  1.  ;;   provided by the Office of Patient Care Services, or cases that are missing data for the procedure.
  1.  ;;
  1.  ;;6. CPT Code is not available for parent and broad procedures in the header section.  CPT Code of the parent order's highest
  1.  ;;   ranked modality case will be printed in the line by line section.  (See 3. above.)
  1.  ;;
  1.  ;;7. Date/Time Registered is the "Imaging Exam Date/Time" entered by the user during Registration.
  1.  ;;
  1.  ;;8. "*" under the "Date Register" column denotes the request was cancelled and re-ordered on the same day that it was cancelled.
  1.  ;;
  1.  ;;9. "p" under the "Case #" column, before the case number, denotes printset case with the highest ranked Procedure Type.