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

RADRPT2A.m

Go to the documentation of this file.
  1. RADRPT2A ;HISC/GJC Radiation dosage report utility two ;01 Aug 2017 1:28 PM
  1. ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7
  1. ;
  1. ;--- IAs ---
  1. ;Call Number Type
  1. ;------------------------------------------------
  1. ;$$SS^%ZTLOAD 10063 S
  1. ;$$GET1^DIQ 2056 S
  1. ;GETS^DIQ 2056 S
  1. ;$$FMTE^XLFDT 10103 S
  1. ;$$CJ^XLFSTR 10104 S
  1. ;^DPT( 10035 S
  1. ;^DIC(4, 10060 S
  1. ;^VA(200, 10090 S
  1. ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
  1. ;
  1. DISPLAY ; display data
  1. ;
  1. ; Where the data for the report is stored:
  1. ; ----------------------------------------------------------------------------
  1. ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"F") = Air Kerma ^ Air kerma Area Product ^ Total Fluoro time (min)
  1. ;
  1. ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S") = CTDIvol (total) ^ DLP (total)
  1. ;
  1. ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,n) = Phantom ptr (#2005.6362) ^ CTDIvol ^ DLP
  1. ; ----------------------------------------------------------------------------
  1. ;
  1. ;RARPTYPE=F:Fluoroscopy;D:Detailed;S:Summary
  1. ;RAFILTR=C:CPT Code;P:Patient;R:Radiologist
  1. ;
  1. S $P(RABORDER,"=",(IOM+1))=""
  1. S RAHDRBY=$S(RAFILTR="C":"CPT Code",RAFILTR="P":"Patient",1:"Radiologist")
  1. S:RARPTYPE="S" RAHDRTY="CT Totals (ONLY) Radiation Dose Summary Report by "_RAHDRBY
  1. S:RARPTYPE="D" RAHDRTY="CT by Series Radiation Dose Summary Report by "_RAHDRBY
  1. S:RARPTYPE="F" RAHDRTY="Fluoro Radiation Dose Summary Report by "_RAHDRBY
  1. S $P(RALINE,"-",(IOM+1))=""
  1. S RAC=9999999.9999,(RAPG,RAQUIT,RAZTSTOP)=0
  1. ;
  1. I ($D(^TMP($J,"RA SORT"))\10)=0 D D XIT Q
  1. .D HDR S X="There are no Radiology exam records of file for the selected filter criteria."
  1. .W !,$$CJ^XLFSTR(X,(IOM+1))
  1. .Q
  1. ;
  1. K ^TMP($J,"RA DISCLAIMER") D DISCLAIM
  1. ;
  1. S RADTE("X")=$O(^TMP($J,"RA SORT",$C(32)),-1) ;last date/time subscript value
  1. S RADTE=0 D HDR
  1. F S RADTE=$O(^TMP($J,"RA SORT",RADTE)) Q:RADTE'>0 D Q:RAQUIT
  1. .;RAXY("X") is the last ascending second level subscript value
  1. .S RAXY="",RAXY("X")=$O(^TMP($J,"RA SORT",RADTE,$C(126)),-1)
  1. .F S RAXY=$O(^TMP($J,"RA SORT",RADTE,RAXY)) Q:RAXY="" D Q:RAQUIT
  1. ..S RADFN=0,RADFN("X")=$O(^TMP($J,"RA SORT",RADTE,RAXY,$C(32)),-1)
  1. ..F S RADFN=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN)) Q:RADFN'>0 D Q:RAQUIT
  1. ...;get patient demographics name & SSN
  1. ...D GETDEM S RACNI=0
  1. ...S RACNI("X")=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,$C(32)),-1)
  1. ...F S RACNI=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI)) Q:RACNI'>0 D Q:RAQUIT
  1. ....S RADTI=(RAC-RADTE),RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
  1. ....S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. ....;get exam/study based data
  1. ....D GETXAM
  1. ....;print by Fluoroscopy
  1. ....D:RARPTYPE="F" PRTFL Q:RAQUIT
  1. ....;print by CT summary
  1. ....D:RARPTYPE="S" CTDATA Q:RAQUIT
  1. ....;print by CT detail
  1. ....D:RARPTYPE="D" CTDATA Q:RAQUIT
  1. ....I $Y>(IOSL-4),(RACNI'=RACNI("X")) D EOS
  1. ....Q
  1. ...Q:RAQUIT I $Y>(IOSL-4),(RADFN'=RADFN("X")) D EOS
  1. ...Q
  1. ..Q:RAQUIT I $Y>(IOSL-4),(RAXY'=RAXY("X")) D EOS
  1. ..Q
  1. .; RAP used as timing mechanism to check if the job was stopped
  1. .Q:RAQUIT S RAZTSTOP=RAZTSTOP+1
  1. .I $D(ZTQUEUED) S:RAZTSTOP#500=0 (RAQUIT,ZTSTOP)=$$S^%ZTLOAD()
  1. .I $Y>(IOSL-4),(RADTE'=RADTE("X")) D EOS
  1. .Q
  1. ;
  1. I RAQUIT D XIT Q
  1. S RADISCLM=""
  1. D:$Y>(IOSL-4) EOS Q:RAQUIT
  1. W ! F RAI=1:1:5 D Q:RAQUIT
  1. .I RARPTYPE="F" Q:RAI=3!(RAI=4)
  1. .I RARPTYPE="S" Q:RAI=3!(RAI=5)
  1. .I RARPTYPE="D" Q:RAI=5
  1. .S RAY=0
  1. .F S RAY=$O(^TMP($J,"RA DISCLAIMER",RAI,RAY)) Q:RAY'>0 D Q:RAQUIT
  1. ..D:$Y>(IOSL-4) EOS Q:RAQUIT
  1. ..W !,$G(^TMP($J,"RA DISCLAIMER",RAI,RAY))
  1. ..Q
  1. .Q:RAQUIT W ! ;break between disclaimers
  1. .Q
  1. D XIT
  1. Q
  1. ;
  1. XIT ;kill variables and exit...
  1. K ^TMP($J,"RA DISCLAIMER"),RA71,RABORDER,RAC,RACN,RACNI,RACPT,RACTDI,RADATE
  1. K RADFN,RADIEN,RADISCLM,RADLP,RADTE,RADTI,RAF,RAFAC,RAFILTR,RAFLMIN,RAFLSEC
  1. K RAHDRBY,RAHDRTY,RAHDS,RAI,RAK,RAKAP,RAL,RALINE,RANAME,RANGE,RAPG,RAPHNTOM
  1. K RAPRC,RAQUIT,RAR,RARPTYPE,RARUNDT,RASSN,RASTF,RASTNUM,RATMP,RAXY,RAY,RAY2
  1. K RAY3,RAZTSTOP,X,Y S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. ;
  1. CTDATA ;print CT detailed series data or print summary totals
  1. ;
  1. ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S") = CTDIvol (total) ^ DLP (total)
  1. ;
  1. ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,RAI) = Phantom ptr (#2005.6362) ^ CTDIvol ^ DLP
  1. ;
  1. N RACTDI,RADLP,RAF,RAHDS,RAI,RAPHNTOM,X
  1. I RARPTYPE="D" D Q:RAQUIT
  1. .S RAHDS=0 ;print the 'high 5'
  1. .F S RAHDS=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,RAHDS)) Q:RAHDS'>0 D Q:RAQUIT
  1. ..S RAF=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,RAHDS))
  1. ..S RAPHNTOM=$$GET1^DIQ(2005.6362,+$P(RAF,U,1)_",",2)
  1. ..S RACTDI=$P(RAF,U,2),RADLP=$P(RAF,U,3)
  1. ..D PRTCTD I $Y>(IOSL-4) D EOS Q:RAQUIT
  1. ..Q
  1. .;print totals for the detailed report
  1. .Q:RAQUIT
  1. .S X=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,"S"))
  1. .S RAHDS="Total",RACTDI=$P(X,U,1),RADLP=$P(X,U,2)
  1. .S RAPHNTOM="" D PRTCTD
  1. .Q
  1. I RARPTYPE="S" D Q:RAQUIT
  1. .S X=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,"S"))
  1. .S RACTDI=$P(X,U,1),RADLP=$P(X,U,2)
  1. .D PRTCTS I $Y>(IOSL-4) D EOS Q:RAQUIT
  1. .Q
  1. Q
  1. ;
  1. GETDEM ;get patient demographics name & SSN
  1. K RATMP,X D GETS^DIQ(2,RADFN_",",".01;.09","E","RATMP")
  1. S RANAME=RATMP(2,RADFN_",",".01","E")
  1. S (RASSN("PID"),X)=RATMP(2,RADFN_",",".09","E")
  1. S RASSN("BID")=$E(X,($L(X)-3),$L(X)) K RATMP,X
  1. Q
  1. ;
  1. GETXAM ;get exam/study based data
  1. S RASTF=$$GET1^DIQ(200,+$P(RAY3,U,15)_",",.01)
  1. S RA71(0)=$G(^RAMIS(71,+$P(RAY3,U,2),0))
  1. S RAPRC=$P(RA71(0),U,1),RA71(9)=+$P(RA71(0),U,9)
  1. ;Example: 73000^X-RAY EXAM OF COLLAR BONE
  1. S RACPT=$P($$NAMCODE^RACPTMSC(RA71(9),RADTE),U,1)
  1. S RADATE=$$FMTE^XLFDT(RADTE,"2DZ")
  1. Q
  1. ;
  1. PRTCTS ;print CT summary data
  1. W !,$E(RANAME,1,27),?29,RASSN("BID"),?35,RADATE,?45,RACPT,?52,$E(RAPRC,1,27),?81,$E(RASTF,1,27)
  1. W ?110,$J(RACTDI,9,2),?121,$J(RADLP,9,2)
  1. Q
  1. ;
  1. PRTCTD ;print CT series/detailed data
  1. W !,$E(RANAME,1,23),?25,RASSN("BID"),?31,RADATE,?41,RACPT,?48,$E(RAPRC,1,23),?73,$E(RASTF,1,23)
  1. W ?98,RAHDS,?107,$J(RACTDI,9,2),?118,$J(RADLP,9,2)
  1. Q
  1. ;
  1. PRTFL ;print fluoroscopy data
  1. S X=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,"F"))
  1. S RAK=$P(X,U,1),RAKAP=$P(X,U,2),RAFLMIN=$P(X,U,3)
  1. W !,$E(RANAME,1,18),?25,RASSN("BID"),?31,RADATE,?41,RACPT,?48,$E(RAPRC,1,25),?75,$E(RASTF,1,23)
  1. W ?99,$J(RAK,10,2),?112,$J(RAKAP,9,2),?125,RAFLMIN K X
  1. Q
  1. ;
  1. EOS ;end of screen - Note: EOS falls through to HDR!
  1. I $E(IOST,1,2)="C-" D Q:RAQUIT
  1. .W !,"Press RETURN to continue or '^' to exit: " R X:DTIME
  1. .S RAQUIT='$T!(X["^") K X
  1. .Q
  1. HDR ;header
  1. S RAPG=RAPG+1
  1. W @IOF,!,"Facility",?20,": ",RAFAC,?120,"Page: ",RAPG
  1. W !,"Station",?20,": ",RASTNUM
  1. W !,"Report Date Range",?20,": ",RANGE
  1. W !,"Report Run Date/Time",?20,": ",RARUNDT
  1. W !,RABORDER D:('$D(RADISCLM)#2) @$S(RARPTYPE="F":"HDRFL",RARPTYPE="D":"HDRCTD",1:"HDRCTS")
  1. Q
  1. ;
  1. HDRCTD ;header for CT detailed
  1. W !,RAHDRTY ;note: RAHDRTY is set at top of the routine
  1. W !!?98,"Highest",!?98,"Dose",?107,"CTDIvol",?118,"DLP"
  1. W !,"Patient",?25,"SSN",?31,"Date",?41,"CPT",?48,"Procedure Name",?73,"Radiologist",?98,"Series",?107,"mGy",?118,"mGy-cm"
  1. W !,RALINE
  1. Q
  1. ;
  1. HDRCTS ;header for CT summary
  1. W !,RAHDRTY
  1. W !!?110,"Sum of",?121,"Sum of",!,?110,"all CDTI",?121,"all DLP"
  1. W !,"Patient",?29,"SSN",?35,"Date",?45,"CPT",?52,"Procedure Name",?81,"Radiologist",?110,"vol mGy",?121,"mGy-cm"
  1. W !,RALINE
  1. Q
  1. ;
  1. HDRFL ;header for fluoroscopy
  1. W !,RAHDRTY
  1. W !?100,"Air",?112,"Air Kerma",?125,"Fluoro",!?100,"Kerma",?112,"Area Product",?125,"Time"
  1. W !,"Patient",?25,"SSN",?31,"Date",?41,"CPT",?48,"Procedure Name",?75,"Radiologist",?100,"mGy",?112,"Gy-cm2",?125,"min"
  1. W !,RALINE
  1. Q
  1. ;
  1. DISCLAIM ;set up the disclaimer statements in an array
  1. S ^TMP($J,"RA DISCLAIMER",1,1)="1. The purpose of this report is to facilitate tracking of procedure doses to"
  1. S ^TMP($J,"RA DISCLAIMER",1,2)=" identify opportunities for improvement. It is not intended to provide a"
  1. S ^TMP($J,"RA DISCLAIMER",1,3)=" complete record of patient dose. Doses resulting from plain films and"
  1. S ^TMP($J,"RA DISCLAIMER",1,4)=" radiopharmaceuticals are not supported."
  1. ;(1,5)=""
  1. S ^TMP($J,"RA DISCLAIMER",2,1)="2. Only procedures for which dose data has been received are listed. Data may"
  1. S ^TMP($J,"RA DISCLAIMER",2,2)=" be missing if the modality does not support DICOM structured dose reporting,"
  1. S ^TMP($J,"RA DISCLAIMER",2,3)=" if the dose report was not sent to VistA Imaging, if the radiology report was"
  1. S ^TMP($J,"RA DISCLAIMER",2,4)=" was not verified, or if the procedure was performed/imported before patches"
  1. S ^TMP($J,"RA DISCLAIMER",2,5)=" MAG*3*137 and RA*5*113 were installed."
  1. ;(2,6)=""
  1. S ^TMP($J,"RA DISCLAIMER",3,1)="3. Only the five highest dose CT series are listed. The total dose refers"
  1. S ^TMP($J,"RA DISCLAIMER",3,2)=" to the sum of all series and so may be larger than the sum of the five"
  1. S ^TMP($J,"RA DISCLAIMER",3,3)=" displayed doses. This report may include CT localizer radiograph(s)"
  1. S ^TMP($J,"RA DISCLAIMER",3,4)=" values as a series and/or included in the total depending on the CT"
  1. S ^TMP($J,"RA DISCLAIMER",3,5)=" manufacturer."
  1. ;(3,6)=""
  1. S ^TMP($J,"RA DISCLAIMER",4,1)="4. Radiology set workflow may show the total rad dose for a patient care event"
  1. S ^TMP($J,"RA DISCLAIMER",4,2)=" under one CPT. If separate exposure instances during a CT examination were"
  1. S ^TMP($J,"RA DISCLAIMER",4,3)=" of different body parts, the total CTDIvol stated here may exceed the actual"
  1. S ^TMP($J,"RA DISCLAIMER",4,4)=" CTDIvol for any body part. More detailed dose information is available on the"
  1. S ^TMP($J,"RA DISCLAIMER",4,5)=" modality (until it is deleted) or in the DICOM Radiation Dose Structured"
  1. S ^TMP($J,"RA DISCLAIMER",4,6)=" Report (RDSR) file stored in VistA Imaging. Viewing the RDSR file is not yet"
  1. S ^TMP($J,"RA DISCLAIMER",4,7)=" supported."
  1. ;(4,8)=""
  1. S ^TMP($J,"RA DISCLAIMER",5,1)="5. Radiology set workflow may show the total rad dose for a patient care event"
  1. S ^TMP($J,"RA DISCLAIMER",5,2)=" under one CPT. Air Kerma Area Product is also called the Dose Area Product."
  1. S ^TMP($J,"RA DISCLAIMER",5,3)=" If fluoroscopy was performed using more than one projection, the total air"
  1. S ^TMP($J,"RA DISCLAIMER",5,4)=" kerma stated here may exceed the air kerma to any single projection. More"
  1. S ^TMP($J,"RA DISCLAIMER",5,5)=" detailed dose information is available on the modality (until it is deleted)"
  1. S ^TMP($J,"RA DISCLAIMER",5,6)=" or in the DICOM Radiation Dose Structured Report (RDSR) file stored in VistA"
  1. S ^TMP($J,"RA DISCLAIMER",5,7)=" Imaging. Viewing the RDSR file is not yet supported."
  1. Q
  1. ;