RADRPT2 ;HISC/GJC Radiation dosage report utility two ;01 Aug 2017 1:54 PM
;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7
;
EN ;entry point
;--- IAs ---
;Call/File Number Type
;------------------------------------------------
;$$GET1^DIQ 2056 S
;DIR 10026 S
;$$FMADD^XLFDT 10103 S
;$$FMTE^XLFDT 10103 S
;$$NOW^XLFDT 10103 S
;$$KSP^XUPARAM 2541 S
;EN^XUTMDEVQ 1519 S
;^DPT( 10035 S
;^DIC(4, 10060 S
;^VA(200, 10090 S
;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
;
;report specifications: sort levels
;1) Type of Report (Fluoro, CT Detailed or CT Summary)
;2) exam date range begin-end
;3) exam attribute: Patient, Pri. Interpreting Staff or Procedure (one/many/all)
K DIR,DIRUT,DIROUT,DTOUT,DUOUT
S DIR(0)="S^F:Fluoroscopy;D:CT Detailed;S:CT Summary"
S DIR("A")="Enter a report format"
S DIR("?",1)="Enter the format of the report: 'F' for a Fluoroscopy summary report"
S DIR("?",2)="'D' for a detailed Cat Scan (CT) report or 'S' for a CT summary report."
S DIR("?",3)=""
S DIR("?")="Enter '^' to exit."
D ^DIR
I $D(DIRUT)#2 K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y Q
S RARPTYPE=Y
K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
;
;enter a date range beginning/ending
D DATE^RAUTL
I '($D(BEGDATE)#2) D XIT Q ;ex: 3120112
I '($D(ENDDATE)#2) D XIT Q ;ex: 3120113
;namespace, make sure we get all the data for this range
S RABEGDT=$$FMADD^XLFDT(BEGDATE,0,0,-1,0) ;ex: 3120111.2359
S RAENDDT=ENDDATE+.2359 ;ex: 3120113.2359
S RANGE=$$FMTE^XLFDT(BEGDATE,"2DZ")_" - "_$$FMTE^XLFDT(ENDDATE,"2DZ")
K BEGDATE,ENDDATE
;
W @IOF K DIR,DIRUT,DIROUT,DTOUT,DUOUT
S DIR(0)="S^C:CPT Code;P:Patient;R:Radiologist"
S DIR("A")="Enter a filter parameter"
S DIR("?",1)="Enter the final filter parameter for the report: 'C' for CPT Code"
S DIR("?",2)="'P' for patient or 'R' for radiologist."
S DIR("?",3)=""
S DIR("?")="Enter '^' to exit."
D ^DIR
I $D(DIRUT)#2 D XIT Q
S RAFILTR=Y
K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
;
S RAQUIT=0
D @$S(RAFILTR="C":"PROC",RAFILTR="P":"PAT",1:"STAFF")
I RAQUIT D XIT Q
;
K RAVAR D INIT ;get facility name, station # & VISN
;
F RA="RABEGDT","RAENDDT","RANGE","RAVISN","RASTNUM","RAFAC","RAFILTR","RARPTYPE","RAQUIT" S RAVAR(RA)=""
S RAX=$S(RAFILTR="R":"^TMP(""RA STFPHYSI"",$J,",RAFILTR="C":"^TMP(""RA PROCI"",$J,",1:"^TMP(""RA PATI"",$J,")
S RAVAR(RAX)=""
D EN^XUTMDEVQ("START^RADRPT2","Package: RA - Print the radiation dosage report",.RAVAR,"QM",1) ;T6
I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,!
D XIT
QUIT
;
START ;start processing
K ^TMP($J,"RA SORT")
;^RADPT("AR",2920610.095,2,7079389.9049)=""
;^RADPT("AR",2920610.1035,1,7079389.8964)=""
S RADTE=RABEGDT,RARUNDT=$$FMTE^XLFDT($$NOW^XLFDT(),"2PM")
S RAC=9999999.9999,(RAP,RAQUIT,RAPG)=0 K ^TMP($J,"RA SORT")
F S RADTE=$O(^RAD("ARAD",RADTE)) Q:RADTE'>0!(RADTE>RAENDDT) D Q:RAQUIT
.S RADFN=0 F S RADFN=$O(^RAD("ARAD",RADTE,RADFN)) Q:RADFN'>0 D Q:RAQUIT
..;
..S RACN=0,RADTI=(RAC-RADTE)
..S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
..; check study i-type versus the user's input
..I $$ITYPCHK(+$P(RAY2,U,2))=0 QUIT
..F S RACN=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)) Q:RACN'>0 D Q:RAQUIT
...S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
...S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
...S RADIEN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U,1) Q:RADIEN=""
...;
...; --------------------- sanity check: pointers to/from 70.3 & 70.03 -------------------
...I $O(^RAD("ARAD",RADTE,RADFN,RACN,0))'=RADIEN Q
...; -------------------------------------------------------------------------------------
...;
...; -------------------------------- patient sort ---------------------------------------
...I RAFILTR="P",($D(^TMP("RA PATI",$J,RADFN))\10) D
....S RASORT=$O(^TMP("RA PATI",$J,RADFN,"")) Q:RASORT=""
....D GETRDOSE K RASORT
....Q
...; -------------------------------------------------------------------------------------
...;
...; ----------------------------- procedure/CPT sort ------------------------------------
...I RAFILTR="C",($D(^TMP("RA PROCI",$J,+$P(RAY3,U,2)))\10) D
....S RASORT=$O(^TMP("RA PROCI",$J,+$P(RAY3,U,2),"")) Q:RASORT=""
....D GETRDOSE K RASORT
....Q
...; -------------------------------------------------------------------------------------
...;
...; ----------------------- primary interpreting staff sort -----------------------------
...I RAFILTR="R",($D(^TMP("RA STFPHYSI",$J,+$P(RAY3,U,15)))\10) D
....S RASORT=$O(^TMP("RA STFPHYSI",$J,+$P(RAY3,U,15),"")) Q:RASORT=""
....D GETRDOSE K RASORT
....Q
...; -------------------------------------------------------------------------------------
...Q
..Q
.Q
;display the data. if no data print the negative report and quit
D DISPLAY^RADRPT2A
K ^TMP($J,"RA SORT"),^TMP("RA PATI"),^TMP("RA PROCI"),^TMP("RA STFPHYSI")
D XIT
QUIT
;
PAT ;sort by patient
K ^TMP($J,"RA PAT"),^TMP("RA PATI",$J)
S RADIC="^RADPT(",RADIC(0)="QEAMZ",RAUTIL="RA PAT"
S RADIC("A")="Select Rad/Nuc Med Patient: ",RADIC("B")="All"
S RADIC("S")="I $D(^RADPT(""EDM"",+Y))"
W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
;Did the user select radiology patients? If not, quit
I $O(^TMP($J,"RA PAT",""))="" D
.S RAQUIT=1 W !!?3,$C(7),"Radiology patient data was not selected."
.Q
;set ^TMP($J,"RA PAT","I",IEN_#2)
E D INT($NA(^TMP($J,"RA PAT")))
Q
;
PROC ;sort by procedure
K ^TMP($J,"RA PROC"),^TMP("RA PROCI",$J)
S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ",RAUTIL="RA PROC"
S RADIC("A")="Select Rad/Nuc Med Procedures: ",RADIC("B")="All"
S RADIC("S")="I $$SCRPROC^RADRPT2(+Y)"
W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
;Did the user select radiology procedures? If not, quit
I $O(^TMP($J,"RA PROC",""))="" D
.S RAQUIT=1 W !!?3,$C(7),"Radiology procedure data was not selected."
.Q
;set ^TMP($J,"RA PROC","I",IEN_#71)
E D INT($NA(^TMP($J,"RA PROC")))
Q
;
SCRPROC(DA) ;screen procedures by type and if inactive.
N RA71 S RA71(0)=$G(^RAMIS(71,DA,0))
;S RA71("I")=$G(^RAMIS(71,DA,"I"))
Q:"^B^P^"[("^"_$P(RA71(0),U,6)_"^") 0
;Q:$L(RA71("I"))&(RA71("I")'>DT) 0
Q 1
;
STAFF ;sort by primary interpreting staff (radiologist)
K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYSI",$J)
S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS"
S RADIC("A")="Select Radiologist: ",RADIC("B")="All"
S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y
;Did the user select staff radiologists? If not, quit
I $O(^TMP($J,"RA STFPHYS",""))="" D
.S RAQUIT=1 W !!?3,$C(7),"Staff Radiologist data was not selected."
.Q
;set ^TMP($J,"RA STFPHYS","I",IEN_#200)
E D INT($NA(^TMP($J,"RA STFPHYS")))
Q
;
INT(ROOT) ;store the internal value of the patient/procedure/radiologist record
N X,Y S X=""
F S X=$O(@ROOT@(X)) Q:X="" D
.S Y=0 F S Y=$O(@ROOT@(X,Y)) Q:Y'>0 D
..S:RAFILTR="C" ^TMP("RA PROCI",$J,Y,X)=""
..S:RAFILTR="P" ^TMP("RA PATI",$J,Y,X)=""
..S:RAFILTR="R" ^TMP("RA STFPHYSI",$J,Y,X)=""
..Q
.K @ROOT@(X)
.Q
Q
;
INIT ;initialize some variables
;return facility name (RAFAC), station # (RASTNUM) & VISN # (RAVISN)
K RAR,X S RAY=$$KSP^XUPARAM("INST")_","
D GETS^DIQ(4,RAY,".01;14*;99","E","RAR")
S RAFAC=RAR(4,RAY,.01,"E") ; Name of facility
S RASTNUM=RAR(4,RAY,99,"E") ; Station Number
K RAR,RAY,X
Q
;
GETRDOSE ;get Rad dosage data
I RARPTYPE="F" D Q
.S X=$G(^RAD(RADIEN,0))
.S RAK=$P(X,U,5),RAKAP=$P(X,U,6)
.S RAFLSEC=$P(X,U,7),RAFLMIN=$J((RAFLSEC/60),5,1)
.;^("F") = air kerma ^ air kerma area product ^ total fluoro time (mins)
.S ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"F")=RAK_U_RAKAP_U_RAFLMIN
.K RAFLMIN,RAFLSEC,RAK,RAKAP,X
.Q
;check sub-file for CT data
I $O(^RAD(RADIEN,"II",0)) D
.K RADLP,RAII,I,X,Y S X="0^0"
.; ^("S") = CTDIvol (total) ^ DLP (total)
.S ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S")="0^0",RADLP=$C(32),I=0
.;get "top five" total all CTDIvol & DLP values
.;formula: CTDIvol=DLP/length of scan (mGy-cm)
.F S RADLP=$O(^RAD(RADIEN,"II","DLP",RADLP),-1) Q:RADLP'>0 D Q:RAQUIT
..S Y=0 F S Y=$O(^RAD(RADIEN,"II","DLP",RADLP,Y)) Q:Y'>0 D Q:RAQUIT
...S RAII(0)=$G(^RAD(RADIEN,"II",Y,0)) Q:RAII(0)=""
...S I=I+1
...S:I'>5 ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,I)=$P(RAII(0),U,3,5)
...S $P(X,U,1)=$P(X,U,1)+$P(RAII(0),U,4) ;CTDIvol
...S $P(X,U,2)=$P(X,U,2)+$P(RAII(0),U,5) ;DLP
...Q
..Q
.S ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S")=X
.K RADLP,RAII,I,X,Y
.Q
Q
;
ITYPCHK(Y) ;i-type check
;input: 'Y' = IEN imaging type of the study
;output: 0 - if the study is of a different i-type than
; the report type selected by the user (saved
; in RARPTYPE)
; 1 - if the study is the same i-type as the
; report type selected by the user
;
; 'RARPRTYPE' is a local variable of global scope. Values
; can be: 'F' for Fluoro (GEN RAD), 'D' for CT (detailed
; rpt) or 'S' for CT (summary rpt)
;
; 'RAY2' is the value if the zero node of 70.02. The
; second piece is a pointer field pointing to the
; IMAGING TYPE (#79.2) file.
;
N X S X=$G(^RA(79.2,Y,0))
S X(3)=$P(X,U,3) ;match against abbrv
I RARPTYPE="F",(X(3)="RAD") Q 1
I RARPTYPE="D",(X(3)="CT") Q 1
I RARPTYPE="S",(X(3)="CT") Q 1
Q 0
;
XIT ;kill variables
K %,DF,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RA,RABEGDT,RAC,RACNI,RADFN,RADIEN,RADTE,RADTI,RAENDDT
K RAFAC,RAFILTR,RAP,RAPG,RAPOP,RANGE,RAQUIT,RAR,RARPTYPE,RARUNDT,RASORT,RASTNUM,RAUTIL
K RAVAR,RAX,RAY,RAY2,RAY3,X,Y,ZTDESC,ZTSAVE,ZTSK
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRADRPT2 9894 printed Sep 23, 2025@20:10:53 Page 2
RADRPT2 ;HISC/GJC Radiation dosage report utility two ;01 Aug 2017 1:54 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7
+2 ;
EN ;entry point
+1 ;--- IAs ---
+2 ;Call/File Number Type
+3 ;------------------------------------------------
+4 ;$$GET1^DIQ 2056 S
+5 ;DIR 10026 S
+6 ;$$FMADD^XLFDT 10103 S
+7 ;$$FMTE^XLFDT 10103 S
+8 ;$$NOW^XLFDT 10103 S
+9 ;$$KSP^XUPARAM 2541 S
+10 ;EN^XUTMDEVQ 1519 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 ;
+16 ;report specifications: sort levels
+17 ;1) Type of Report (Fluoro, CT Detailed or CT Summary)
+18 ;2) exam date range begin-end
+19 ;3) exam attribute: Patient, Pri. Interpreting Staff or Procedure (one/many/all)
+20 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
+21 SET DIR(0)="S^F:Fluoroscopy;D:CT Detailed;S:CT Summary"
+22 SET DIR("A")="Enter a report format"
+23 SET DIR("?",1)="Enter the format of the report: 'F' for a Fluoroscopy summary report"
+24 SET DIR("?",2)="'D' for a detailed Cat Scan (CT) report or 'S' for a CT summary report."
+25 SET DIR("?",3)=""
+26 SET DIR("?")="Enter '^' to exit."
+27 DO ^DIR
+28 IF $DATA(DIRUT)#2
KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
QUIT
+29 SET RARPTYPE=Y
+30 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+31 ;
+32 ;enter a date range beginning/ending
+33 DO DATE^RAUTL
+34 ;ex: 3120112
IF '($DATA(BEGDATE)#2)
DO XIT
QUIT
+35 ;ex: 3120113
IF '($DATA(ENDDATE)#2)
DO XIT
QUIT
+36 ;namespace, make sure we get all the data for this range
+37 ;ex: 3120111.2359
SET RABEGDT=$$FMADD^XLFDT(BEGDATE,0,0,-1,0)
+38 ;ex: 3120113.2359
SET RAENDDT=ENDDATE+.2359
+39 SET RANGE=$$FMTE^XLFDT(BEGDATE,"2DZ")_" - "_$$FMTE^XLFDT(ENDDATE,"2DZ")
+40 KILL BEGDATE,ENDDATE
+41 ;
+42 WRITE @IOF
KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
+43 SET DIR(0)="S^C:CPT Code;P:Patient;R:Radiologist"
+44 SET DIR("A")="Enter a filter parameter"
+45 SET DIR("?",1)="Enter the final filter parameter for the report: 'C' for CPT Code"
+46 SET DIR("?",2)="'P' for patient or 'R' for radiologist."
+47 SET DIR("?",3)=""
+48 SET DIR("?")="Enter '^' to exit."
+49 DO ^DIR
+50 IF $DATA(DIRUT)#2
DO XIT
QUIT
+51 SET RAFILTR=Y
+52 KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
+53 ;
+54 SET RAQUIT=0
+55 DO @$SELECT(RAFILTR="C":"PROC",RAFILTR="P":"PAT",1:"STAFF")
+56 IF RAQUIT
DO XIT
QUIT
+57 ;
+58 ;get facility name, station # & VISN
KILL RAVAR
DO INIT
+59 ;
+60 FOR RA="RABEGDT","RAENDDT","RANGE","RAVISN","RASTNUM","RAFAC","RAFILTR","RARPTYPE","RAQUIT"
SET RAVAR(RA)=""
+61 SET RAX=$SELECT(RAFILTR="R":"^TMP(""RA STFPHYSI"",$J,",RAFILTR="C":"^TMP(""RA PROCI"",$J,",1:"^TMP(""RA PATI"",$J,")
+62 SET RAVAR(RAX)=""
+63 ;T6
DO EN^XUTMDEVQ("START^RADRPT2","Package: RA - Print the radiation dosage report",.RAVAR,"QM",1)
+64 IF +$GET(ZTSK)>0
WRITE !!,"Task Number: "_ZTSK,!
+65 DO XIT
+66 QUIT
+67 ;
START ;start processing
+1 KILL ^TMP($JOB,"RA SORT")
+2 ;^RADPT("AR",2920610.095,2,7079389.9049)=""
+3 ;^RADPT("AR",2920610.1035,1,7079389.8964)=""
+4 SET RADTE=RABEGDT
SET RARUNDT=$$FMTE^XLFDT($$NOW^XLFDT(),"2PM")
+5 SET RAC=9999999.9999
SET (RAP,RAQUIT,RAPG)=0
KILL ^TMP($JOB,"RA SORT")
+6 FOR
SET RADTE=$ORDER(^RAD("ARAD",RADTE))
if RADTE'>0!(RADTE>RAENDDT)
QUIT
Begin DoDot:1
+7 SET RADFN=0
FOR
SET RADFN=$ORDER(^RAD("ARAD",RADTE,RADFN))
if RADFN'>0
QUIT
Begin DoDot:2
+8 ;
+9 SET RACN=0
SET RADTI=(RAC-RADTE)
+10 SET RAY2=$GET(^RADPT(RADFN,"DT",RADTI,0))
+11 ; check study i-type versus the user's input
+12 IF $$ITYPCHK(+$PIECE(RAY2,U,2))=0
QUIT
+13 FOR
SET RACN=$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN))
if RACN'>0
QUIT
Begin DoDot:3
+14 SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
+15 SET RAY3=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+16 SET RADIEN=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U,1)
if RADIEN=""
QUIT
+17 ;
+18 ; --------------------- sanity check: pointers to/from 70.3 & 70.03 -------------------
+19 IF $ORDER(^RAD("ARAD",RADTE,RADFN,RACN,0))'=RADIEN
QUIT
+20 ; -------------------------------------------------------------------------------------
+21 ;
+22 ; -------------------------------- patient sort ---------------------------------------
+23 IF RAFILTR="P"
IF ($DATA(^TMP("RA PATI",$JOB,RADFN))\10)
Begin DoDot:4
+24 SET RASORT=$ORDER(^TMP("RA PATI",$JOB,RADFN,""))
if RASORT=""
QUIT
+25 DO GETRDOSE
KILL RASORT
+26 QUIT
End DoDot:4
+27 ; -------------------------------------------------------------------------------------
+28 ;
+29 ; ----------------------------- procedure/CPT sort ------------------------------------
+30 IF RAFILTR="C"
IF ($DATA(^TMP("RA PROCI",$JOB,+$PIECE(RAY3,U,2)))\10)
Begin DoDot:4
+31 SET RASORT=$ORDER(^TMP("RA PROCI",$JOB,+$PIECE(RAY3,U,2),""))
if RASORT=""
QUIT
+32 DO GETRDOSE
KILL RASORT
+33 QUIT
End DoDot:4
+34 ; -------------------------------------------------------------------------------------
+35 ;
+36 ; ----------------------- primary interpreting staff sort -----------------------------
+37 IF RAFILTR="R"
IF ($DATA(^TMP("RA STFPHYSI",$JOB,+$PIECE(RAY3,U,15)))\10)
Begin DoDot:4
+38 SET RASORT=$ORDER(^TMP("RA STFPHYSI",$JOB,+$PIECE(RAY3,U,15),""))
if RASORT=""
QUIT
+39 DO GETRDOSE
KILL RASORT
+40 QUIT
End DoDot:4
+41 ; -------------------------------------------------------------------------------------
+42 QUIT
End DoDot:3
if RAQUIT
QUIT
+43 QUIT
End DoDot:2
if RAQUIT
QUIT
+44 QUIT
End DoDot:1
if RAQUIT
QUIT
+45 ;display the data. if no data print the negative report and quit
+46 DO DISPLAY^RADRPT2A
+47 KILL ^TMP($JOB,"RA SORT"),^TMP("RA PATI"),^TMP("RA PROCI"),^TMP("RA STFPHYSI")
+48 DO XIT
+49 QUIT
+50 ;
PAT ;sort by patient
+1 KILL ^TMP($JOB,"RA PAT"),^TMP("RA PATI",$JOB)
+2 SET RADIC="^RADPT("
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA PAT"
+3 SET RADIC("A")="Select Rad/Nuc Med Patient: "
SET RADIC("B")="All"
+4 SET RADIC("S")="I $D(^RADPT(""EDM"",+Y))"
+5 WRITE !!
DO EN1^RASELCT(.RADIC,RAUTIL)
KILL %W,%Y1,DIC,RADIC,RAUTIL,X,Y
+6 ;Did the user select radiology patients? If not, quit
+7 IF $ORDER(^TMP($JOB,"RA PAT",""))=""
Begin DoDot:1
+8 SET RAQUIT=1
WRITE !!?3,$CHAR(7),"Radiology patient data was not selected."
+9 QUIT
End DoDot:1
+10 ;set ^TMP($J,"RA PAT","I",IEN_#2)
+11 IF '$TEST
DO INT($NAME(^TMP($JOB,"RA PAT")))
+12 QUIT
+13 ;
PROC ;sort by procedure
+1 KILL ^TMP($JOB,"RA PROC"),^TMP("RA PROCI",$JOB)
+2 SET RADIC="^RAMIS(71,"
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA PROC"
+3 SET RADIC("A")="Select Rad/Nuc Med Procedures: "
SET RADIC("B")="All"
+4 SET RADIC("S")="I $$SCRPROC^RADRPT2(+Y)"
+5 WRITE !!
DO EN1^RASELCT(.RADIC,RAUTIL)
KILL %W,%Y1,DIC,RADIC,RAUTIL,X,Y
+6 ;Did the user select radiology procedures? If not, quit
+7 IF $ORDER(^TMP($JOB,"RA PROC",""))=""
Begin DoDot:1
+8 SET RAQUIT=1
WRITE !!?3,$CHAR(7),"Radiology procedure data was not selected."
+9 QUIT
End DoDot:1
+10 ;set ^TMP($J,"RA PROC","I",IEN_#71)
+11 IF '$TEST
DO INT($NAME(^TMP($JOB,"RA PROC")))
+12 QUIT
+13 ;
SCRPROC(DA) ;screen procedures by type and if inactive.
+1 NEW RA71
SET RA71(0)=$GET(^RAMIS(71,DA,0))
+2 ;S RA71("I")=$G(^RAMIS(71,DA,"I"))
+3 if "^B^P^"[("^"_$PIECE(RA71(0),U,6)_"^")
QUIT 0
+4 ;Q:$L(RA71("I"))&(RA71("I")'>DT) 0
+5 QUIT 1
+6 ;
STAFF ;sort by primary interpreting staff (radiologist)
+1 KILL ^TMP($JOB,"RA STFPHYS"),^TMP("RA STFPHYSI",$JOB)
+2 SET RADIC="^VA(200,"
SET RADIC(0)="QEAMZ"
SET RAUTIL="RA STFPHYS"
+3 SET RADIC("A")="Select Radiologist: "
SET RADIC("B")="All"
+4 SET RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10"
+5 WRITE !!
DO EN1^RASELCT(.RADIC,RAUTIL)
KILL %W,%Y1,DIC,RADIC,RAUTIL,X,Y
+6 ;Did the user select staff radiologists? If not, quit
+7 IF $ORDER(^TMP($JOB,"RA STFPHYS",""))=""
Begin DoDot:1
+8 SET RAQUIT=1
WRITE !!?3,$CHAR(7),"Staff Radiologist data was not selected."
+9 QUIT
End DoDot:1
+10 ;set ^TMP($J,"RA STFPHYS","I",IEN_#200)
+11 IF '$TEST
DO INT($NAME(^TMP($JOB,"RA STFPHYS")))
+12 QUIT
+13 ;
INT(ROOT) ;store the internal value of the patient/procedure/radiologist record
+1 NEW X,Y
SET X=""
+2 FOR
SET X=$ORDER(@ROOT@(X))
if X=""
QUIT
Begin DoDot:1
+3 SET Y=0
FOR
SET Y=$ORDER(@ROOT@(X,Y))
if Y'>0
QUIT
Begin DoDot:2
+4 if RAFILTR="C"
SET ^TMP("RA PROCI",$JOB,Y,X)=""
+5 if RAFILTR="P"
SET ^TMP("RA PATI",$JOB,Y,X)=""
+6 if RAFILTR="R"
SET ^TMP("RA STFPHYSI",$JOB,Y,X)=""
+7 QUIT
End DoDot:2
+8 KILL @ROOT@(X)
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
INIT ;initialize some variables
+1 ;return facility name (RAFAC), station # (RASTNUM) & VISN # (RAVISN)
+2 KILL RAR,X
SET RAY=$$KSP^XUPARAM("INST")_","
+3 DO GETS^DIQ(4,RAY,".01;14*;99","E","RAR")
+4 ; Name of facility
SET RAFAC=RAR(4,RAY,.01,"E")
+5 ; Station Number
SET RASTNUM=RAR(4,RAY,99,"E")
+6 KILL RAR,RAY,X
+7 QUIT
+8 ;
GETRDOSE ;get Rad dosage data
+1 IF RARPTYPE="F"
Begin DoDot:1
+2 SET X=$GET(^RAD(RADIEN,0))
+3 SET RAK=$PIECE(X,U,5)
SET RAKAP=$PIECE(X,U,6)
+4 SET RAFLSEC=$PIECE(X,U,7)
SET RAFLMIN=$JUSTIFY((RAFLSEC/60),5,1)
+5 ;^("F") = air kerma ^ air kerma area product ^ total fluoro time (mins)
+6 SET ^TMP($JOB,"RA SORT",RADTE,RASORT,RADFN,RACNI,"F")=RAK_U_RAKAP_U_RAFLMIN
+7 KILL RAFLMIN,RAFLSEC,RAK,RAKAP,X
+8 QUIT
End DoDot:1
QUIT
+9 ;check sub-file for CT data
+10 IF $ORDER(^RAD(RADIEN,"II",0))
Begin DoDot:1
+11 KILL RADLP,RAII,I,X,Y
SET X="0^0"
+12 ; ^("S") = CTDIvol (total) ^ DLP (total)
+13 SET ^TMP($JOB,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S")="0^0"
SET RADLP=$CHAR(32)
SET I=0
+14 ;get "top five" total all CTDIvol & DLP values
+15 ;formula: CTDIvol=DLP/length of scan (mGy-cm)
+16 FOR
SET RADLP=$ORDER(^RAD(RADIEN,"II","DLP",RADLP),-1)
if RADLP'>0
QUIT
Begin DoDot:2
+17 SET Y=0
FOR
SET Y=$ORDER(^RAD(RADIEN,"II","DLP",RADLP,Y))
if Y'>0
QUIT
Begin DoDot:3
+18 SET RAII(0)=$GET(^RAD(RADIEN,"II",Y,0))
if RAII(0)=""
QUIT
+19 SET I=I+1
+20 if I'>5
SET ^TMP($JOB,"RA SORT",RADTE,RASORT,RADFN,RACNI,I)=$PIECE(RAII(0),U,3,5)
+21 ;CTDIvol
SET $PIECE(X,U,1)=$PIECE(X,U,1)+$PIECE(RAII(0),U,4)
+22 ;DLP
SET $PIECE(X,U,2)=$PIECE(X,U,2)+$PIECE(RAII(0),U,5)
+23 QUIT
End DoDot:3
if RAQUIT
QUIT
+24 QUIT
End DoDot:2
if RAQUIT
QUIT
+25 SET ^TMP($JOB,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S")=X
+26 KILL RADLP,RAII,I,X,Y
+27 QUIT
End DoDot:1
+28 QUIT
+29 ;
ITYPCHK(Y) ;i-type check
+1 ;input: 'Y' = IEN imaging type of the study
+2 ;output: 0 - if the study is of a different i-type than
+3 ; the report type selected by the user (saved
+4 ; in RARPTYPE)
+5 ; 1 - if the study is the same i-type as the
+6 ; report type selected by the user
+7 ;
+8 ; 'RARPRTYPE' is a local variable of global scope. Values
+9 ; can be: 'F' for Fluoro (GEN RAD), 'D' for CT (detailed
+10 ; rpt) or 'S' for CT (summary rpt)
+11 ;
+12 ; 'RAY2' is the value if the zero node of 70.02. The
+13 ; second piece is a pointer field pointing to the
+14 ; IMAGING TYPE (#79.2) file.
+15 ;
+16 NEW X
SET X=$GET(^RA(79.2,Y,0))
+17 ;match against abbrv
SET X(3)=$PIECE(X,U,3)
+18 IF RARPTYPE="F"
IF (X(3)="RAD")
QUIT 1
+19 IF RARPTYPE="D"
IF (X(3)="CT")
QUIT 1
+20 IF RARPTYPE="S"
IF (X(3)="CT")
QUIT 1
+21 QUIT 0
+22 ;
XIT ;kill variables
+1 KILL %,DF,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RA,RABEGDT,RAC,RACNI,RADFN,RADIEN,RADTE,RADTI,RAENDDT
+2 KILL RAFAC,RAFILTR,RAP,RAPG,RAPOP,RANGE,RAQUIT,RAR,RARPTYPE,RARUNDT,RASORT,RASTNUM,RAUTIL
+3 KILL RAVAR,RAX,RAY,RAY2,RAY3,X,Y,ZTDESC,ZTSAVE,ZTSK
+4 QUIT
+5 ;
