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