RADRPT1 ;HISC/GJC Radiation dosage report utility one ;12 Jul 2017 10:09 AM
;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7
;
EN ;entry point
;--- IAs ---
;Call/File Number Type
;------------------------------------------------
;^DIC 10006 S
;$$GET1^DIQ 2056 S
;^DIR 10026 S
;$$FMTE^XLFDT 10103 S
;$$CJ^XLFSTR 10104 S
;EN^XUTMDEVQ 1519 S
;^DPT( 10035 S
;CPT/HCPCS file 81 5408 S
;^VA(200, 10060 S
;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
;
;report specifications: sort levels
;1) select a single patient
;2) a replica of 'Profile of Rad/Nuc Med Exams'
;
PAT ;select a patient
K %,DIC,DIRUT,DTOUT,DUOUT,X,Y
S DIC="^RADPT(",DIC("A")="Select Patient: "
S DIC("S")="I $D(^RADPT(""EDM"",+Y))"
S DIC(0)="QEAMZ",D="EDM^B",DIC("W")=""
D MIX^DIC1 ;p119 from KILL to KILL
K %,D,DIC,DIRUT,DTOUT,DUOUT
I +Y=-1 K X,Y Q
S RADFN=+Y ;we have our patient
;get exam data for this specific patient
K X,Y D RT^RAPROQ
Q:'$D(^DPT(RADFN,0))#2 S RADPT(0)=$G(^(0))
S RA("NAME")=$P(RADPT(0),U),RA("SSN")=$$SSN^RAUTL
;does Radiology use the SSAN? returns '1' for yes; '0' for no
;S RA("SSAN")=$$USESSAN^RAHLRU1()
S RA("HDR")="**** Radiation dose for "_RA("NAME")_" ****"
;
;get the Rad Dosage Data from file 70.3
;RAY = record #'s file 70.3
;RAP = numeric representation of each selectable record
;RAQ = loop exit logic
;RAR = user's selection
S RAC=9999999.9999,(RAP,RAQ,RAY)=0
S RAR="" K ^TMP($J,"RAEX")
;are there more than one exam for this patient?
S RA("ALPHA")=$O(^RAD("B",RADFN,0)),RA("OMEGA")=$O(^RAD("B",RADFN,$C(32)),-1)
S RA("STRING")="Exam"
S:RA("ALPHA")'=RA("OMEGA") RA("STRING")="Exam(s)"
;
D HDR ;
F S RAY=$O(^RAD("B",RADFN,RAY)) Q:'RAY D Q:RAQ
.S RAX=$G(^RAD(RAY,0)),RADTE=$P(RAX,U,2),RACN=$P(RAX,U,3),RADTI=(RAC-RADTE)
.S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) Q:'RACNI ;can determine case
.S RAP=RAP+1 ; RAP = # of exams counter
.S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
.S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
.S RA("RAMIS")=$G(^RAMIS(71,+$P(RAY3,U,2),0))
.S RA("PRC")=$P(RA("RAMIS"),U)
.S RA("CPT")=$$GET1^DIQ(81,$P(RA("RAMIS"),U,9),.01)
.S X=$P(RAY2,U) ;3121120.1321
.S RA("EXDT")=$$FMTE^XLFDT(X,2) ;MM/DD/YY@HH:MM:SS format
.S X=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
.S:X'="" RA("ACC")=X
.S:X="" RA("ACC")=$E($P(RAY2,U),4,5)_$E($P(RAY2,U),6,7)_$E($P(RAY2,U),2,3)_"-"_$P(RAY3,U)
.S RA("PIS")=$$GET1^DIQ(200,$P(RAY3,U,15),.01) ;ptr value or null
.S RARPT=$P(RAY3,U,17) ;referencing a pointer field value could be null
.; ^TMP($J,"RAEX",RAP)=IEN 70.3 ^ RADFN ^ Exam Date ^ inv. Exam Date (IEN 70.02)
.; ^ Case Number ^ IEN EXAMINATIONS (70.03) ^ Report (if none null)
.S ^TMP($J,"RAEX",RAP)=RAY_U_RADFN_U_RADTE_U_RADTI_U_RACN_U_RACNI_U_RARPT
.W !,RAP,?3,RA("ACC"),?21,RA("EXDT"),?37,$E(RA("PRC"),1,16),?55,RA("CPT"),?62,$E(RA("PIS"),1,17)
.I $Y>(IOSL-6) D
..S:RAY'=RA("OMEGA") RAHLP="Enter a '^' to exit or <return> to continue."
..S:RAY=RA("OMEGA") RAHLP="Enter a '^' or <return> to exit."
..D ASK(RAHLP)
..;straight exit '^' or timeout
..I RAR="^" S RAQ=-1 Q
..;no more data to display (user enters return)
..I RAY=RA("OMEGA"),(RAR="") S RAQ=-1 Q
..;more data to dispay, user chooses to continue
..I RAR="" D HDR Q
..;the user selected a record/list of records...
..I +RAR S RAQ=1
..Q
.Q
;now check if the user went through all the record w/o selecting
; - the user exited the loop abruptly
I RAQ=-1 D XIT QUIT
; - the user fell through the loop without selecting
I RAR="" S RAHLP="Enter a '^' or <return> to exit." W ! D ASK(RAHLP)
;the user exited w/o selecting a list
I RAR="^"!(RAR="") D XIT QUIT
; - the user salected
I +RAR D
.D DATA ;save off only the user's selections
.S ZTSAVE("RADFN")=""
.S ZTSAVE("^TMP($J,""RAEX"",")="",ZTRTN="EN^RADRPT1A"
.S ZTDESC="RA-Radiation dosage report (Patient Profile format)"
.D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1) ;"QM" w/ T6
.I $G(ZTSK) W !!,"This report has been tasked: "_ZTSK
.Q
D XIT
Q
;
HDR ;header - study selection process
W @IOF,!!,$$CJ^XLFSTR(RA("HDR"),80)
W !?62,"Primary"
W !?3,"Accession No.",?21,"Exam Date/Time",?37,"Procedure Name",?55,"CPT",?62,"Interpreting" ;P119 Accession <sp>
W !?3,"-------------",?21,"--------------",?37,"--------------",?55,"-----",?62,"------------"
Q
;
XIT ;kill variables set ZTREQ then exit
K %,%H,%I,N,RA,RAC,RACN,RACNI,RADFN,RADTE,RADPT,RADTI,RAHLP,RAP,RAQ,RAR,RARPT,RASSN
K RAX,RAY,RAY2,RAY3,RTFL,X,X1,Y,Z,ZTDESC,ZTRTN,ZTSAVE,ZTSK
K ^TMP($J,"RAEX")
;S:$D(ZTQUEUED) ZTREQ="@"
Q
;
ASK(RAHLP) ;ask the user for a response/end of screen
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y S DIR(0)="LO^1:"_RAP_":0"
S DIR("A")="Enter a number or range of numbers between 1 and "_RAP
S DIR("?",1)="This response must be a list or range, e.g., 1,3,5 or 2-4,8."
S DIR("?")=RAHLP D ^DIR
S:$D(DTOUT)#2!($D(DUOUT)#2) Y="^"
;Y can be: '^', "" (upon <CR>) or a value.
S RAR=Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
QUIT
;
DATA ;Make sure only the records selected by the patient
;are preserved.
;input: RAR - the user's selections
S XRAR=","_RAR,I=0
F S I=$O(^TMP($J,"RAEX",I)) Q:'I D
.I XRAR'[(","_I_",") K ^TMP($J,"RAEX",I)
K I,XRAR
Q
;
CT ;----------------------- get Rad Dose (CT SCAN) -------------------
;called from RADRPT1A
S RAHDR=$$CJ^XLFSTR("Rad Dose",IOM,"-")
S RACOL("A1")="Irradiation Event",RACOL("A2")="(5 highest DLP)"
s $P(RACOL("A3"),"-",($L(RACOL("A1"))+1))=""
S RACOL("B1")="CTDIvol",RACOL("B2")=" (mGy)"
S $P(RACOL("B3"),"-",($L(RACOL("B1"))+1))=""
S RACOL("C1")="DLP",RACOL("C2")="(mGy-cm)"
S $P(RACOL("C3"),"-",($L(RACOL("C2"))+1))=""
;S RACOL("E2")="Target Region",$P(RACOL("E3"),"-",($L(RACOL("E2"))+1))=""
I $Y>(IOSL-6) D Q:RAQUIT
.D HDR1^RADRPT1
.Q
E D
.W !,RAHDR D CTCOL
.Q
S RAB=$C(32),RAE=0,RAGJC="0^0"
F S RAB=$O(^RAD(RARAD,"II","DLP",RAB),-1) Q:RAB'>0 D Q:RAQUIT
.S RACC=0 F S RACC=$O(^RAD(RARAD,"II","DLP",RAB,RACC)) Q:RACC'>0 D Q:RAQUIT
..S RAII(0)=$G(^RAD(RARAD,"II",RACC,0)) Q:RAII(0)=""
..I $Y>(IOSL-4) D HDR1^RADRPT1 Q:RAQUIT
..S RAE=RAE+1 ; # IIUID records
..S RAII(2)=$$GET1^DIQ(2005.6361,+$P(RAII(0),U,2)_",",2) ;ATR - CODE MEANING fld
..S $P(RAGJC,U,1)=$P(RAGJC,U,1)+$P(RAII(0),U,4) ; CTDIvol totals
..S $P(RAGJC,U,2)=$P(RAGJC,U,2)+$P(RAII(0),U,5) ; DLP totals
..;Columns: Sequence, CTDIvol, DLP, Irradiation Type & Target Region only the top five
..;Note: Target Region column & display removed 07/11/2017 b/c of data accuracy issues T6
..;W:RAE'>5 !?2,RAE,?24,$J($P(RAII(0),U,4),8,2),?39,$J($P(RAII(0),U,5),8,2),?54,$E(RAII(2),1,25)
..W:RAE'>5 !?2,RAE,?24,$J($P(RAII(0),U,4),8,2),?39,$J($P(RAII(0),U,5),8,2)
..Q
.Q
I 'RAQUIT D
.W !,"Total Exam CTDIvol: "_$J(+$P(RAGJC,U,1),8,2)_" mGy from all irradiation events."
.W !,"Total Exam DLP: "_$J(+$P(RAGJC,U,2),8,2)_" mGy-cm from all irradiation events."
.W !!,"Total # irradiation events: ",RAE
.Q
K RAB,RACC,RACOL,RAE,RAGJC,RAHD,RAII,RAIRT,RATMP,RATR
Q
;
CTCOL ;print CT column headers
W !,RACOL("A1"),?24,RACOL("B1"),?41,RACOL("C1")
;W !,RACOL("A2"),?24,RACOL("B2"),?39,RACOL("C2"),?54,RACOL("E2")
;W !,RACOL("A3"),?24,RACOL("B3"),?39,RACOL("C3"),?54,RACOL("E3")
W !,RACOL("A2"),?24,RACOL("B2"),?39,RACOL("C2") ;T6
W !,RACOL("A3"),?24,RACOL("B3"),?39,RACOL("C3") ;T6
Q
;
HDR1 ;header/end of screen logic
;RAHDR: is dynamic; its value is based on the section
;HDR^RADRPT1 is called from.
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
S RAPG=RAPG+1 W @IOF,!,RATITLE
W !,"Date: ",RANODT,?69,"Page: ",RAPG
W !,RABORDR
W !?RATAB(1),"Name: ",$E(RA("NAME"),1,27)_" "_RA("BID")
W ?RATAB(4),"Exam Date: ",$E(RAY2A(70.02,RAIEN,".01","E"),1,21)
W !?RATAB(1),"Procedure: ",$E(RAPRC,1,30)
W ?RATAB(4),"Case Number: ",RA("RACN")
W !,RAHDR D CTCOL
;specifc to CT SCANS - print column data
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRADRPT1 8255 printed Jun 11, 2024@22:22:14 Page 2
RADRPT1 ;HISC/GJC Radiation dosage report utility one ;12 Jul 2017 10:09 AM
+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 ;^DIC 10006 S
+5 ;$$GET1^DIQ 2056 S
+6 ;^DIR 10026 S
+7 ;$$FMTE^XLFDT 10103 S
+8 ;$$CJ^XLFSTR 10104 S
+9 ;EN^XUTMDEVQ 1519 S
+10 ;^DPT( 10035 S
+11 ;CPT/HCPCS file 81 5408 S
+12 ;^VA(200, 10060 S
+13 ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private
+14 ;
+15 ;report specifications: sort levels
+16 ;1) select a single patient
+17 ;2) a replica of 'Profile of Rad/Nuc Med Exams'
+18 ;
PAT ;select a patient
+1 KILL %,DIC,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIC="^RADPT("
SET DIC("A")="Select Patient: "
+3 SET DIC("S")="I $D(^RADPT(""EDM"",+Y))"
+4 SET DIC(0)="QEAMZ"
SET D="EDM^B"
SET DIC("W")=""
+5 ;p119 from KILL to KILL
DO MIX^DIC1
+6 KILL %,D,DIC,DIRUT,DTOUT,DUOUT
+7 IF +Y=-1
KILL X,Y
QUIT
+8 ;we have our patient
SET RADFN=+Y
+9 ;get exam data for this specific patient
+10 KILL X,Y
DO RT^RAPROQ
+11 if '$DATA(^DPT(RADFN,0))#2
QUIT
SET RADPT(0)=$GET(^(0))
+12 SET RA("NAME")=$PIECE(RADPT(0),U)
SET RA("SSN")=$$SSN^RAUTL
+13 ;does Radiology use the SSAN? returns '1' for yes; '0' for no
+14 ;S RA("SSAN")=$$USESSAN^RAHLRU1()
+15 SET RA("HDR")="**** Radiation dose for "_RA("NAME")_" ****"
+16 ;
+17 ;get the Rad Dosage Data from file 70.3
+18 ;RAY = record #'s file 70.3
+19 ;RAP = numeric representation of each selectable record
+20 ;RAQ = loop exit logic
+21 ;RAR = user's selection
+22 SET RAC=9999999.9999
SET (RAP,RAQ,RAY)=0
+23 SET RAR=""
KILL ^TMP($JOB,"RAEX")
+24 ;are there more than one exam for this patient?
+25 SET RA("ALPHA")=$ORDER(^RAD("B",RADFN,0))
SET RA("OMEGA")=$ORDER(^RAD("B",RADFN,$CHAR(32)),-1)
+26 SET RA("STRING")="Exam"
+27 if RA("ALPHA")'=RA("OMEGA")
SET RA("STRING")="Exam(s)"
+28 ;
+29 ;
DO HDR
+30 FOR
SET RAY=$ORDER(^RAD("B",RADFN,RAY))
if 'RAY
QUIT
Begin DoDot:1
+31 SET RAX=$GET(^RAD(RAY,0))
SET RADTE=$PIECE(RAX,U,2)
SET RACN=$PIECE(RAX,U,3)
SET RADTI=(RAC-RADTE)
+32 ;can determine case
SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
if 'RACNI
QUIT
+33 ; RAP = # of exams counter
SET RAP=RAP+1
+34 SET RAY2=$GET(^RADPT(RADFN,"DT",RADTI,0))
+35 SET RAY3=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+36 SET RA("RAMIS")=$GET(^RAMIS(71,+$PIECE(RAY3,U,2),0))
+37 SET RA("PRC")=$PIECE(RA("RAMIS"),U)
+38 SET RA("CPT")=$$GET1^DIQ(81,$PIECE(RA("RAMIS"),U,9),.01)
+39 ;3121120.1321
SET X=$PIECE(RAY2,U)
+40 ;MM/DD/YY@HH:MM:SS format
SET RA("EXDT")=$$FMTE^XLFDT(X,2)
+41 SET X=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
+42 if X'=""
SET RA("ACC")=X
+43 if X=""
SET RA("ACC")=$EXTRACT($PIECE(RAY2,U),4,5)_$EXTRACT($PIECE(RAY2,U),6,7)_$EXTRACT($PIECE(RAY2,U),2,3)_"-"_$PIECE(RAY3,U)
+44 ;ptr value or null
SET RA("PIS")=$$GET1^DIQ(200,$PIECE(RAY3,U,15),.01)
+45 ;referencing a pointer field value could be null
SET RARPT=$PIECE(RAY3,U,17)
+46 ; ^TMP($J,"RAEX",RAP)=IEN 70.3 ^ RADFN ^ Exam Date ^ inv. Exam Date (IEN 70.02)
+47 ; ^ Case Number ^ IEN EXAMINATIONS (70.03) ^ Report (if none null)
+48 SET ^TMP($JOB,"RAEX",RAP)=RAY_U_RADFN_U_RADTE_U_RADTI_U_RACN_U_RACNI_U_RARPT
+49 WRITE !,RAP,?3,RA("ACC"),?21,RA("EXDT"),?37,$EXTRACT(RA("PRC"),1,16),?55,RA("CPT"),?62,$EXTRACT(RA("PIS"),1,17)
+50 IF $Y>(IOSL-6)
Begin DoDot:2
+51 if RAY'=RA("OMEGA")
SET RAHLP="Enter a '^' to exit or <return> to continue."
+52 if RAY=RA("OMEGA")
SET RAHLP="Enter a '^' or <return> to exit."
+53 DO ASK(RAHLP)
+54 ;straight exit '^' or timeout
+55 IF RAR="^"
SET RAQ=-1
QUIT
+56 ;no more data to display (user enters return)
+57 IF RAY=RA("OMEGA")
IF (RAR="")
SET RAQ=-1
QUIT
+58 ;more data to dispay, user chooses to continue
+59 IF RAR=""
DO HDR
QUIT
+60 ;the user selected a record/list of records...
+61 IF +RAR
SET RAQ=1
+62 QUIT
End DoDot:2
+63 QUIT
End DoDot:1
if RAQ
QUIT
+64 ;now check if the user went through all the record w/o selecting
+65 ; - the user exited the loop abruptly
+66 IF RAQ=-1
DO XIT
QUIT
+67 ; - the user fell through the loop without selecting
+68 IF RAR=""
SET RAHLP="Enter a '^' or <return> to exit."
WRITE !
DO ASK(RAHLP)
+69 ;the user exited w/o selecting a list
+70 IF RAR="^"!(RAR="")
DO XIT
QUIT
+71 ; - the user salected
+72 IF +RAR
Begin DoDot:1
+73 ;save off only the user's selections
DO DATA
+74 SET ZTSAVE("RADFN")=""
+75 SET ZTSAVE("^TMP($J,""RAEX"",")=""
SET ZTRTN="EN^RADRPT1A"
+76 SET ZTDESC="RA-Radiation dosage report (Patient Profile format)"
+77 ;"QM" w/ T6
DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+78 IF $GET(ZTSK)
WRITE !!,"This report has been tasked: "_ZTSK
+79 QUIT
End DoDot:1
+80 DO XIT
+81 QUIT
+82 ;
HDR ;header - study selection process
+1 WRITE @IOF,!!,$$CJ^XLFSTR(RA("HDR"),80)
+2 WRITE !?62,"Primary"
+3 ;P119 Accession <sp>
WRITE !?3,"Accession No.",?21,"Exam Date/Time",?37,"Procedure Name",?55,"CPT",?62,"Interpreting"
+4 WRITE !?3,"-------------",?21,"--------------",?37,"--------------",?55,"-----",?62,"------------"
+5 QUIT
+6 ;
XIT ;kill variables set ZTREQ then exit
+1 KILL %,%H,%I,N,RA,RAC,RACN,RACNI,RADFN,RADTE,RADPT,RADTI,RAHLP,RAP,RAQ,RAR,RARPT,RASSN
+2 KILL RAX,RAY,RAY2,RAY3,RTFL,X,X1,Y,Z,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+3 KILL ^TMP($JOB,"RAEX")
+4 ;S:$D(ZTQUEUED) ZTREQ="@"
+5 QUIT
+6 ;
ASK(RAHLP) ;ask the user for a response/end of screen
+1 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
SET DIR(0)="LO^1:"_RAP_":0"
+2 SET DIR("A")="Enter a number or range of numbers between 1 and "_RAP
+3 SET DIR("?",1)="This response must be a list or range, e.g., 1,3,5 or 2-4,8."
+4 SET DIR("?")=RAHLP
DO ^DIR
+5 if $DATA(DTOUT)#2!($DATA(DUOUT)#2)
SET Y="^"
+6 ;Y can be: '^', "" (upon <CR>) or a value.
+7 SET RAR=Y
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+8 QUIT
+9 ;
DATA ;Make sure only the records selected by the patient
+1 ;are preserved.
+2 ;input: RAR - the user's selections
+3 SET XRAR=","_RAR
SET I=0
+4 FOR
SET I=$ORDER(^TMP($JOB,"RAEX",I))
if 'I
QUIT
Begin DoDot:1
+5 IF XRAR'[(","_I_",")
KILL ^TMP($JOB,"RAEX",I)
End DoDot:1
+6 KILL I,XRAR
+7 QUIT
+8 ;
CT ;----------------------- get Rad Dose (CT SCAN) -------------------
+1 ;called from RADRPT1A
+2 SET RAHDR=$$CJ^XLFSTR("Rad Dose",IOM,"-")
+3 SET RACOL("A1")="Irradiation Event"
SET RACOL("A2")="(5 highest DLP)"
+4 SET $PIECE(RACOL("A3"),"-",($LENGTH(RACOL("A1"))+1))=""
+5 SET RACOL("B1")="CTDIvol"
SET RACOL("B2")=" (mGy)"
+6 SET $PIECE(RACOL("B3"),"-",($LENGTH(RACOL("B1"))+1))=""
+7 SET RACOL("C1")="DLP"
SET RACOL("C2")="(mGy-cm)"
+8 SET $PIECE(RACOL("C3"),"-",($LENGTH(RACOL("C2"))+1))=""
+9 ;S RACOL("E2")="Target Region",$P(RACOL("E3"),"-",($L(RACOL("E2"))+1))=""
+10 IF $Y>(IOSL-6)
Begin DoDot:1
+11 DO HDR1^RADRPT1
+12 QUIT
End DoDot:1
if RAQUIT
QUIT
+13 IF '$TEST
Begin DoDot:1
+14 WRITE !,RAHDR
DO CTCOL
+15 QUIT
End DoDot:1
+16 SET RAB=$CHAR(32)
SET RAE=0
SET RAGJC="0^0"
+17 FOR
SET RAB=$ORDER(^RAD(RARAD,"II","DLP",RAB),-1)
if RAB'>0
QUIT
Begin DoDot:1
+18 SET RACC=0
FOR
SET RACC=$ORDER(^RAD(RARAD,"II","DLP",RAB,RACC))
if RACC'>0
QUIT
Begin DoDot:2
+19 SET RAII(0)=$GET(^RAD(RARAD,"II",RACC,0))
if RAII(0)=""
QUIT
+20 IF $Y>(IOSL-4)
DO HDR1^RADRPT1
if RAQUIT
QUIT
+21 ; # IIUID records
SET RAE=RAE+1
+22 ;ATR - CODE MEANING fld
SET RAII(2)=$$GET1^DIQ(2005.6361,+$PIECE(RAII(0),U,2)_",",2)
+23 ; CTDIvol totals
SET $PIECE(RAGJC,U,1)=$PIECE(RAGJC,U,1)+$PIECE(RAII(0),U,4)
+24 ; DLP totals
SET $PIECE(RAGJC,U,2)=$PIECE(RAGJC,U,2)+$PIECE(RAII(0),U,5)
+25 ;Columns: Sequence, CTDIvol, DLP, Irradiation Type & Target Region only the top five
+26 ;Note: Target Region column & display removed 07/11/2017 b/c of data accuracy issues T6
+27 ;W:RAE'>5 !?2,RAE,?24,$J($P(RAII(0),U,4),8,2),?39,$J($P(RAII(0),U,5),8,2),?54,$E(RAII(2),1,25)
+28 if RAE'>5
WRITE !?2,RAE,?24,$JUSTIFY($PIECE(RAII(0),U,4),8,2),?39,$JUSTIFY($PIECE(RAII(0),U,5),8,2)
+29 QUIT
End DoDot:2
if RAQUIT
QUIT
+30 QUIT
End DoDot:1
if RAQUIT
QUIT
+31 IF 'RAQUIT
Begin DoDot:1
+32 WRITE !,"Total Exam CTDIvol: "_$JUSTIFY(+$PIECE(RAGJC,U,1),8,2)_" mGy from all irradiation events."
+33 WRITE !,"Total Exam DLP: "_$JUSTIFY(+$PIECE(RAGJC,U,2),8,2)_" mGy-cm from all irradiation events."
+34 WRITE !!,"Total # irradiation events: ",RAE
+35 QUIT
End DoDot:1
+36 KILL RAB,RACC,RACOL,RAE,RAGJC,RAHD,RAII,RAIRT,RATMP,RATR
+37 QUIT
+38 ;
CTCOL ;print CT column headers
+1 WRITE !,RACOL("A1"),?24,RACOL("B1"),?41,RACOL("C1")
+2 ;W !,RACOL("A2"),?24,RACOL("B2"),?39,RACOL("C2"),?54,RACOL("E2")
+3 ;W !,RACOL("A3"),?24,RACOL("B3"),?39,RACOL("C3"),?54,RACOL("E3")
+4 ;T6
WRITE !,RACOL("A2"),?24,RACOL("B2"),?39,RACOL("C2")
+5 ;T6
WRITE !,RACOL("A3"),?24,RACOL("B3"),?39,RACOL("C3")
+6 QUIT
+7 ;
HDR1 ;header/end of screen logic
+1 ;RAHDR: is dynamic; its value is based on the section
+2 ;HDR^RADRPT1 is called from.
+3 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+4 WRITE !,"Press RETURN to continue or '^' to exit: "
READ X:DTIME
+5 SET RAQUIT='$TEST!(X["^")
KILL X
+6 QUIT
End DoDot:1
if RAQUIT
QUIT
+7 SET RAPG=RAPG+1
WRITE @IOF,!,RATITLE
+8 WRITE !,"Date: ",RANODT,?69,"Page: ",RAPG
+9 WRITE !,RABORDR
+10 WRITE !?RATAB(1),"Name: ",$EXTRACT(RA("NAME"),1,27)_" "_RA("BID")
+11 WRITE ?RATAB(4),"Exam Date: ",$EXTRACT(RAY2A(70.02,RAIEN,".01","E"),1,21)
+12 WRITE !?RATAB(1),"Procedure: ",$EXTRACT(RAPRC,1,30)
+13 WRITE ?RATAB(4),"Case Number: ",RA("RACN")
+14 WRITE !,RAHDR
DO CTCOL
+15 ;specifc to CT SCANS - print column data
+16 QUIT
+17 ;
