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

RADRPT1.m

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