Released RA*5*119 SEQ #122 Extracted from mail message **KIDS**:RA*5.0*119^ **INSTALL NAME** RA*5.0*119 "BLD",9041,0) RA*5.0*119^RADIOLOGY/NUCLEAR MEDICINE^0^3170807^y "BLD",9041,1,0) ^^3^3^3170804^^^^ "BLD",9041,1,1,0) Patch one hundred and nineteen for the VistA Radiology/Nuclear Medicine "BLD",9041,1,2,0) 5.0 application. Please review FORUM's Patch Module description and "BLD",9041,1,3,0) installation instructions for RA*5.0*119 before installing this patch. "BLD",9041,4,0) ^9.64PA^70^2 "BLD",9041,4,70,0) 70 "BLD",9041,4,70,2,0) ^9.641^70.03^1 "BLD",9041,4,70,2,70.03,0) EXAMINATIONS (sub-file) "BLD",9041,4,70,2,70.03,1,0) ^9.6411^1.1^1 "BLD",9041,4,70,2,70.03,1,1.1,0) RADIATION ABSORBED DOSE "BLD",9041,4,70,222) y^n^p^^^^n^^n "BLD",9041,4,70,224) "BLD",9041,4,70.3,0) 70.3 "BLD",9041,4,70.3,222) y^n^f^^^^n "BLD",9041,4,"APDD",70,70.03) "BLD",9041,4,"APDD",70,70.03,1.1) "BLD",9041,4,"B",70,70) "BLD",9041,4,"B",70.3,70.3) "BLD",9041,6.3) 7 "BLD",9041,"ABPKG") n "BLD",9041,"INID") n^n "BLD",9041,"INIT") RAIPS119 "BLD",9041,"KRN",0) ^9.67PA^779.2^20 "BLD",9041,"KRN",.4,0) .4 "BLD",9041,"KRN",.401,0) .401 "BLD",9041,"KRN",.402,0) .402 "BLD",9041,"KRN",.403,0) .403 "BLD",9041,"KRN",.5,0) .5 "BLD",9041,"KRN",.84,0) .84 "BLD",9041,"KRN",3.6,0) 3.6 "BLD",9041,"KRN",3.8,0) 3.8 "BLD",9041,"KRN",9.2,0) 9.2 "BLD",9041,"KRN",9.8,0) 9.8 "BLD",9041,"KRN",9.8,"NM",0) ^9.68A^7^7 "BLD",9041,"KRN",9.8,"NM",1,0) RADUTL^^0^B42704172 "BLD",9041,"KRN",9.8,"NM",2,0) RADRPT1^^0^B53164228 "BLD",9041,"KRN",9.8,"NM",3,0) RADRPT1A^^0^B114118092 "BLD",9041,"KRN",9.8,"NM",4,0) RAIPS119^^0^B473200 "BLD",9041,"KRN",9.8,"NM",5,0) RADRPT2A^^0^B115224298 "BLD",9041,"KRN",9.8,"NM",6,0) RADRPT2^^0^B68075283 "BLD",9041,"KRN",9.8,"NM",7,0) RA119ENV^^0^B3380968 "BLD",9041,"KRN",9.8,"NM","B","RA119ENV",7) "BLD",9041,"KRN",9.8,"NM","B","RADRPT1",2) "BLD",9041,"KRN",9.8,"NM","B","RADRPT1A",3) "BLD",9041,"KRN",9.8,"NM","B","RADRPT2",6) "BLD",9041,"KRN",9.8,"NM","B","RADRPT2A",5) "BLD",9041,"KRN",9.8,"NM","B","RADUTL",1) "BLD",9041,"KRN",9.8,"NM","B","RAIPS119",4) "BLD",9041,"KRN",19,0) 19 "BLD",9041,"KRN",19.1,0) 19.1 "BLD",9041,"KRN",101,0) 101 "BLD",9041,"KRN",409.61,0) 409.61 "BLD",9041,"KRN",771,0) 771 "BLD",9041,"KRN",779.2,0) 779.2 "BLD",9041,"KRN",870,0) 870 "BLD",9041,"KRN",8989.51,0) 8989.51 "BLD",9041,"KRN",8989.52,0) 8989.52 "BLD",9041,"KRN",8994,0) 8994 "BLD",9041,"KRN","B",.4,.4) "BLD",9041,"KRN","B",.401,.401) "BLD",9041,"KRN","B",.402,.402) "BLD",9041,"KRN","B",.403,.403) "BLD",9041,"KRN","B",.5,.5) "BLD",9041,"KRN","B",.84,.84) "BLD",9041,"KRN","B",3.6,3.6) "BLD",9041,"KRN","B",3.8,3.8) "BLD",9041,"KRN","B",9.2,9.2) "BLD",9041,"KRN","B",9.8,9.8) "BLD",9041,"KRN","B",19,19) "BLD",9041,"KRN","B",19.1,19.1) "BLD",9041,"KRN","B",101,101) "BLD",9041,"KRN","B",409.61,409.61) "BLD",9041,"KRN","B",771,771) "BLD",9041,"KRN","B",779.2,779.2) "BLD",9041,"KRN","B",870,870) "BLD",9041,"KRN","B",8989.51,8989.51) "BLD",9041,"KRN","B",8989.52,8989.52) "BLD",9041,"KRN","B",8994,8994) "BLD",9041,"PRE") RA119ENV "BLD",9041,"QUES",0) ^9.62^^ "BLD",9041,"REQB",0) ^9.611^3^3 "BLD",9041,"REQB",1,0) RA*5.0*113^2 "BLD",9041,"REQB",2,0) MAG*3.0*157^2 "BLD",9041,"REQB",3,0) MAG*3.0*172^2 "BLD",9041,"REQB","B","MAG*3.0*157",2) "BLD",9041,"REQB","B","MAG*3.0*172",3) "BLD",9041,"REQB","B","RA*5.0*113",1) "FIA",70) RAD/NUC MED PATIENT "FIA",70,0) ^RADPT( "FIA",70,0,0) 70IP "FIA",70,0,1) y^n^p^^^^n^^n "FIA",70,0,10) "FIA",70,0,11) "FIA",70,0,"RLRO") "FIA",70,0,"VR") 5.0^RA "FIA",70,70) 1 "FIA",70,70.03) 1 "FIA",70,70.03,1.1) "FIA",70.3) RADIATION ABSORBED DOSE "FIA",70.3,0) ^RAD( "FIA",70.3,0,0) 70.3PI "FIA",70.3,0,1) y^n^f^^^^n "FIA",70.3,0,10) "FIA",70.3,0,11) "FIA",70.3,0,"RLRO") "FIA",70.3,0,"VR") 5.0^RA "FIA",70.3,70.3) 0 "FIA",70.3,70.31) 0 "INIT") RAIPS119 "IX",70,70,"EDM",0) 70^EDM^'EDM' - helps lookup patients with radiation exposure.^R^^F^IR^W^70.03^^^^^LS "IX",70,70,"EDM",.1,0) ^^31^31^3150506^ "IX",70,70,"EDM",.1,1,0) The 'EDM' cross reference will be used to identify patient "IX",70,70,"EDM",.1,2,0) care events that exposed the patient to radiation. This cross "IX",70,70,"EDM",.1,3,0) reference increase the efficiency of patient lookups on radiation "IX",70,70,"EDM",.1,4,0) dose based reports. "IX",70,70,"EDM",.1,5,0) "IX",70,70,"EDM",.1,6,0) Variable definitions: "IX",70,70,"EDM",.1,7,0) --------------------- "IX",70,70,"EDM",.1,8,0) X(2): Is the DFN of the patient record in the PATIENT (#2) "IX",70,70,"EDM",.1,9,0) file. "IX",70,70,"EDM",.1,10,0) "IX",70,70,"EDM",.1,11,0) DA(2): Is also the DFN of the patient record in the PATIENT "IX",70,70,"EDM",.1,12,0) (#2) file. "IX",70,70,"EDM",.1,13,0) "IX",70,70,"EDM",.1,14,0) DA(1): This value is the record number of the exam date in "IX",70,70,"EDM",.1,15,0) the REGISTERED EXAMS (#70.02) sub-file. "IX",70,70,"EDM",.1,16,0) "IX",70,70,"EDM",.1,17,0) The value is the inverse date/time of the examination. "IX",70,70,"EDM",.1,18,0) value is calculated as follows: "IX",70,70,"EDM",.1,19,0) "IX",70,70,"EDM",.1,20,0) 9999999.9999 - ("minus") FileMan internal date/time format. "IX",70,70,"EDM",.1,21,0) "IX",70,70,"EDM",.1,22,0) Example: 9999999.9999-3140210.1236=6859789.8763 "IX",70,70,"EDM",.1,23,0) DA(1)=6859789.8763 "IX",70,70,"EDM",.1,24,0) "IX",70,70,"EDM",.1,25,0) DA: The record number of the study (EXAMINATIONS (#70.03) sub-file) "IX",70,70,"EDM",.1,26,0) "IX",70,70,"EDM",.1,27,0) The result is a cross reference defined as follows: "IX",70,70,"EDM",.1,28,0) ^RADPT("EDM",76,76,6868885.8551,1) "IX",70,70,"EDM",.1,29,0) "IX",70,70,"EDM",.1,30,0) This cross reference can be now used in a lookup screen to "IX",70,70,"EDM",.1,31,0) speed up the lookup for patients with a radiation dose record. "IX",70,70,"EDM",1) S ^RADPT("EDM",X(2),DA(2),DA(1),DA)="" "IX",70,70,"EDM",1.4) S X=X(1)]"" "IX",70,70,"EDM",2) K ^RADPT("EDM",X(2),DA(2),DA(1),DA) "IX",70,70,"EDM",2.4) S X=X(1)]"" "IX",70,70,"EDM",2.5) K ^RADPT("EDM") "IX",70,70,"EDM",11.1,0) ^.114IA^2^2 "IX",70,70,"EDM",11.1,1,0) 1^F^70.03^1.1^^^F "IX",70,70,"EDM",11.1,2,0) 2^C^^^^1 "IX",70,70,"EDM",11.1,2,1.5) S X=DA(2) "IX",70.3,70.3,"ARAD",0) 70.3^ARAD^This is a compound cross-reference on fields: .01, .02 & .03.^R^^R^IR^I^70.3^^^^^S "IX",70.3,70.3,"ARAD",.1,0) ^^15^15^3130130^ "IX",70.3,70.3,"ARAD",.1,1,0) This is a compound cross-reference that ties fields .01, .02 & .03 "IX",70.3,70.3,"ARAD",.1,2,0) together. "IX",70.3,70.3,"ARAD",.1,3,0) "IX",70.3,70.3,"ARAD",.1,4,0) The construction of this cross reference is as follows: "IX",70.3,70.3,"ARAD",.1,5,0) ^RAD("ARAD",EXAM DATE/TIME,PATIENT,CASE NUMBER)="" "IX",70.3,70.3,"ARAD",.1,6,0) "IX",70.3,70.3,"ARAD",.1,7,0) EXAM DATE/TIME is field number .02; PATIENT is field number .01 & "IX",70.3,70.3,"ARAD",.1,8,0) CASE NUMBER is field number .03. "IX",70.3,70.3,"ARAD",.1,9,0) "IX",70.3,70.3,"ARAD",.1,10,0) ^RAD("ARAD",.02,.01,.03)="" "IX",70.3,70.3,"ARAD",.1,11,0) "IX",70.3,70.3,"ARAD",.1,12,0) This lookup cross reference allows faster lookups for patients "IX",70.3,70.3,"ARAD",.1,13,0) exposed to radiation at the time the examination was performed because it "IX",70.3,70.3,"ARAD",.1,14,0) ties in nicely with file-wide "AR" cross reference on EXAM DATE (70.02) "IX",70.3,70.3,"ARAD",.1,15,0) and the "B" cross reference on CASE NUMBER (70.03). "IX",70.3,70.3,"ARAD",1) S ^RAD("ARAD",$E(X(1),1,12),$E(X(2),1,15),$E(X(3),1,5),DA)="" "IX",70.3,70.3,"ARAD",2) K ^RAD("ARAD",$E(X(1),1,12),$E(X(2),1,15),$E(X(3),1,5),DA) "IX",70.3,70.3,"ARAD",2.5) K ^RAD("ARAD") "IX",70.3,70.3,"ARAD",11.1,0) ^.114IA^5^3 "IX",70.3,70.3,"ARAD",11.1,3,0) 3^F^70.3^.03^5^3^F "IX",70.3,70.3,"ARAD",11.1,4,0) 1^F^70.3^.02^12^1^F "IX",70.3,70.3,"ARAD",11.1,5,0) 2^F^70.3^.01^15^2^F "IX",70.3,70.31,"DLP",0) 70.31^DLP^This cross-reference sorts the sub-file records by DLP.^R^^F^IR^I^70.31^^^^^LS "IX",70.3,70.31,"DLP",.1,0) ^^2^2^3130530^ "IX",70.3,70.31,"DLP",.1,1,0) This cross-reference will sort the Irradiation Instance sub-file "IX",70.3,70.31,"DLP",.1,2,0) records by Dose Length Product (DLP). "IX",70.3,70.31,"DLP",1) S ^RAD(DA(1),"II","DLP",$E(X,1,30),DA)="" "IX",70.3,70.31,"DLP",2) K ^RAD(DA(1),"II","DLP",$E(X,1,30),DA) "IX",70.3,70.31,"DLP",2.5) K ^RAD(DA(1),"II","DLP") "IX",70.3,70.31,"DLP",11.1,0) ^.114IA^1^1 "IX",70.3,70.31,"DLP",11.1,1,0) 1^F^70.31^5^30^1^F "MBREQ") 0 "PKG",18,-1) 1^1 "PKG",18,0) RADIOLOGY/NUCLEAR MEDICINE^RA^REGISTERS PATIENTS,RECORDS EXAMS,PROFILES,AMIS REPORTS "PKG",18,20,0) ^9.402P^^ "PKG",18,22,0) ^9.49I^1^1 "PKG",18,22,1,0) 5.0^3051109^2980407^50 "PKG",18,22,1,"PAH",1,0) 119^3170807 "PKG",18,22,1,"PAH",1,1,0) ^^3^3^3170807 "PKG",18,22,1,"PAH",1,1,1,0) Patch one hundred and nineteen for the VistA Radiology/Nuclear Medicine "PKG",18,22,1,"PAH",1,1,2,0) 5.0 application. Please review FORUM's Patch Module description and "PKG",18,22,1,"PAH",1,1,3,0) installation instructions for RA*5.0*119 before installing this patch. "PRE") RA119ENV "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 7 "RTN","RA119ENV") 0^7^B3380968^n/a "RTN","RA119ENV",1,0) RA119ENV ;HISC/GJC Radiation dosage report utility one ;26 Apr 2017 2:18 PM "RTN","RA119ENV",2,0) ;;5.0;Radiology/Nuclear Medicine;**119**;Mar 16, 1998;Build 7 "RTN","RA119ENV",3,0) ; "RTN","RA119ENV",4,0) EN ;entry point "RTN","RA119ENV",5,0) ;--- IAs --- "RTN","RA119ENV",6,0) ;Call/File Number Type "RTN","RA119ENV",7,0) ;------------------------------------------------ "RTN","RA119ENV",8,0) ;$$PROD^XUPROD 4440 S "RTN","RA119ENV",9,0) ;$$KSP^XUPARAM 2541 S "RTN","RA119ENV",10,0) ;File #2005.632 6732 P "RTN","RA119ENV",11,0) ;File #2005.633 6733 P "RTN","RA119ENV",12,0) ; "RTN","RA119ENV",13,0) ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private "RTN","RA119ENV",14,0) ; "RTN","RA119ENV",15,0) ;If the site manager has designated this as the production "RTN","RA119ENV",16,0) ;account our API (#4440) will return a 1, otherwise it "RTN","RA119ENV",17,0) ;returns 0. The default check is against the PRODUCTION "RTN","RA119ENV",18,0) ;field (#501) in the KERNEL SYSTEM PARAMETERS (#8989.3) file. "RTN","RA119ENV",19,0) ; "RTN","RA119ENV",20,0) ;note: If this is a test account can exit now. "RTN","RA119ENV",21,0) Q:$$PROD^XUPROD()=0 "RTN","RA119ENV",22,0) ; "RTN","RA119ENV",23,0) N RAI,RAS,RAX,RAY "RTN","RA119ENV",24,0) S RAS=$$KSP^XUPARAM("WHERE"),RAY=0 "RTN","RA119ENV",25,0) ; "RTN","RA119ENV",26,0) ;FNC>W !,$$KSP^XUPARAM("WHERE") "RTN","RA119ENV",27,0) ; FAYETTVL-NC.DOMAIN.EXT "RTN","RA119ENV",28,0) ;FNC> "RTN","RA119ENV",29,0) ; "RTN","RA119ENV",30,0) ;LEX>W !,$$KSP^XUPARAM("WHERE") "RTN","RA119ENV",31,0) ; LEXINGTON.DOMAIN.EXT "RTN","RA119ENV",32,0) ;LEX> "RTN","RA119ENV",33,0) ; "RTN","RA119ENV",34,0) ;STL>w !,$$KSP^XUPARAM("WHERE") "RTN","RA119ENV",35,0) ; ST-LOUIS.DOMAIN.EXT "RTN","RA119ENV",36,0) ;STL> "RTN","RA119ENV",37,0) ; "RTN","RA119ENV",38,0) F RAI=1:1 S RAX=$P($T(SITE+RAI),";;",2,99) Q:RAX="" D Q:RAY "RTN","RA119ENV",39,0) .S:RAS=RAX RAY=1 "RTN","RA119ENV",40,0) .Q "RTN","RA119ENV",41,0) ; "RTN","RA119ENV",42,0) ;RAY = 1: matched one of the trusted test sites "RTN","RA119ENV",43,0) ; if one of the sites quit w/o aborting install "RTN","RA119ENV",44,0) Q:RAY "RTN","RA119ENV",45,0) ; "RTN","RA119ENV",46,0) ; if not one of the test sites there cannot be rad dose "RTN","RA119ENV",47,0) ; data in files: "RTN","RA119ENV",48,0) ; - 70.3. "RTN","RA119ENV",49,0) ; - CT DOSE #2005.632 "RTN","RA119ENV",50,0) ; - PROJECTION X-RAY DOSE #2005.633 "RTN","RA119ENV",51,0) ; "RTN","RA119ENV",52,0) ;RAY is still set to zero if we've gone this far. "RTN","RA119ENV",53,0) ; "RTN","RA119ENV",54,0) I $O(^RAD(0))>0 D "RTN","RA119ENV",55,0) .D MES^XPDUTL("Dose data was found in the RADIATION ABSORBED DOSE file.") "RTN","RA119ENV",56,0) .S XPDQUIT=2 "RTN","RA119ENV",57,0) .Q "RTN","RA119ENV",58,0) I $O(^MAGV(2005.632,0))>0 D "RTN","RA119ENV",59,0) .D MES^XPDUTL("Dose data was found in the CT DOSE file.") "RTN","RA119ENV",60,0) .S XPDQUIT=2 "RTN","RA119ENV",61,0) .Q "RTN","RA119ENV",62,0) ; "RTN","RA119ENV",63,0) I $O(^MAGV(2005.633,0))>0 D "RTN","RA119ENV",64,0) .D MES^XPDUTL("Dose data was found in the PROJECTION X-RAY DOSE file.") "RTN","RA119ENV",65,0) .S XPDQUIT=2 "RTN","RA119ENV",66,0) .Q "RTN","RA119ENV",67,0) ; "RTN","RA119ENV",68,0) D:$G(XPDQUIT)=2 BMES^XPDUTL(XPDNM_" cannot be installed.") "RTN","RA119ENV",69,0) ; "RTN","RA119ENV",70,0) Q "RTN","RA119ENV",71,0) ; "RTN","RA119ENV",72,0) SITE ;test sites I trust & have ready access into their production accounts "RTN","RA119ENV",73,0) ;;FAYETTVL-NC.DOMAIN.EXT "RTN","RA119ENV",74,0) ;;LEXINGTON.DOMAIN.EXT "RTN","RA119ENV",75,0) ;;ST-LOUIS.DOMAIN.EXT "RTN","RA119ENV",76,0) ;; "RTN","RADRPT1") 0^2^B53164228^B50436794 "RTN","RADRPT1",1,0) RADRPT1 ;HISC/GJC Radiation dosage report utility one ;12 Jul 2017 10:09 AM "RTN","RADRPT1",2,0) ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7 "RTN","RADRPT1",3,0) ; "RTN","RADRPT1",4,0) EN ;entry point "RTN","RADRPT1",5,0) ;--- IAs --- "RTN","RADRPT1",6,0) ;Call/File Number Type "RTN","RADRPT1",7,0) ;------------------------------------------------ "RTN","RADRPT1",8,0) ;^DIC 10006 S "RTN","RADRPT1",9,0) ;$$GET1^DIQ 2056 S "RTN","RADRPT1",10,0) ;^DIR 10026 S "RTN","RADRPT1",11,0) ;$$FMTE^XLFDT 10103 S "RTN","RADRPT1",12,0) ;$$CJ^XLFSTR 10104 S "RTN","RADRPT1",13,0) ;EN^XUTMDEVQ 1519 S "RTN","RADRPT1",14,0) ;^DPT( 10035 S "RTN","RADRPT1",15,0) ;CPT/HCPCS file 81 5408 S "RTN","RADRPT1",16,0) ;^VA(200, 10060 S "RTN","RADRPT1",17,0) ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private "RTN","RADRPT1",18,0) ; "RTN","RADRPT1",19,0) ;report specifications: sort levels "RTN","RADRPT1",20,0) ;1) select a single patient "RTN","RADRPT1",21,0) ;2) a replica of 'Profile of Rad/Nuc Med Exams' "RTN","RADRPT1",22,0) ; "RTN","RADRPT1",23,0) PAT ;select a patient "RTN","RADRPT1",24,0) K %,DIC,DIRUT,DTOUT,DUOUT,X,Y "RTN","RADRPT1",25,0) S DIC="^RADPT(",DIC("A")="Select Patient: " "RTN","RADRPT1",26,0) S DIC("S")="I $D(^RADPT(""EDM"",+Y))" "RTN","RADRPT1",27,0) S DIC(0)="QEAMZ",D="EDM^B",DIC("W")="" "RTN","RADRPT1",28,0) D MIX^DIC1 ;p119 from KILL to KILL "RTN","RADRPT1",29,0) K %,D,DIC,DIRUT,DTOUT,DUOUT "RTN","RADRPT1",30,0) I +Y=-1 K X,Y Q "RTN","RADRPT1",31,0) S RADFN=+Y ;we have our patient "RTN","RADRPT1",32,0) ;get exam data for this specific patient "RTN","RADRPT1",33,0) K X,Y D RT^RAPROQ "RTN","RADRPT1",34,0) Q:'$D(^DPT(RADFN,0))#2 S RADPT(0)=$G(^(0)) "RTN","RADRPT1",35,0) S RA("NAME")=$P(RADPT(0),U),RA("SSN")=$$SSN^RAUTL "RTN","RADRPT1",36,0) ;does Radiology use the SSAN? returns '1' for yes; '0' for no "RTN","RADRPT1",37,0) ;S RA("SSAN")=$$USESSAN^RAHLRU1() "RTN","RADRPT1",38,0) S RA("HDR")="**** Radiation dose for "_RA("NAME")_" ****" "RTN","RADRPT1",39,0) ; "RTN","RADRPT1",40,0) ;get the Rad Dosage Data from file 70.3 "RTN","RADRPT1",41,0) ;RAY = record #'s file 70.3 "RTN","RADRPT1",42,0) ;RAP = numeric representation of each selectable record "RTN","RADRPT1",43,0) ;RAQ = loop exit logic "RTN","RADRPT1",44,0) ;RAR = user's selection "RTN","RADRPT1",45,0) S RAC=9999999.9999,(RAP,RAQ,RAY)=0 "RTN","RADRPT1",46,0) S RAR="" K ^TMP($J,"RAEX") "RTN","RADRPT1",47,0) ;are there more than one exam for this patient? "RTN","RADRPT1",48,0) S RA("ALPHA")=$O(^RAD("B",RADFN,0)),RA("OMEGA")=$O(^RAD("B",RADFN,$C(32)),-1) "RTN","RADRPT1",49,0) S RA("STRING")="Exam" "RTN","RADRPT1",50,0) S:RA("ALPHA")'=RA("OMEGA") RA("STRING")="Exam(s)" "RTN","RADRPT1",51,0) ; "RTN","RADRPT1",52,0) D HDR ; "RTN","RADRPT1",53,0) F S RAY=$O(^RAD("B",RADFN,RAY)) Q:'RAY D Q:RAQ "RTN","RADRPT1",54,0) .S RAX=$G(^RAD(RAY,0)),RADTE=$P(RAX,U,2),RACN=$P(RAX,U,3),RADTI=(RAC-RADTE) "RTN","RADRPT1",55,0) .S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) Q:'RACNI ;can determine case "RTN","RADRPT1",56,0) .S RAP=RAP+1 ; RAP = # of exams counter "RTN","RADRPT1",57,0) .S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RADRPT1",58,0) .S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RADRPT1",59,0) .S RA("RAMIS")=$G(^RAMIS(71,+$P(RAY3,U,2),0)) "RTN","RADRPT1",60,0) .S RA("PRC")=$P(RA("RAMIS"),U) "RTN","RADRPT1",61,0) .S RA("CPT")=$$GET1^DIQ(81,$P(RA("RAMIS"),U,9),.01) "RTN","RADRPT1",62,0) .S X=$P(RAY2,U) ;3121120.1321 "RTN","RADRPT1",63,0) .S RA("EXDT")=$$FMTE^XLFDT(X,2) ;MM/DD/YY@HH:MM:SS format "RTN","RADRPT1",64,0) .S X=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI) "RTN","RADRPT1",65,0) .S:X'="" RA("ACC")=X "RTN","RADRPT1",66,0) .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) "RTN","RADRPT1",67,0) .S RA("PIS")=$$GET1^DIQ(200,$P(RAY3,U,15),.01) ;ptr value or null "RTN","RADRPT1",68,0) .S RARPT=$P(RAY3,U,17) ;referencing a pointer field value could be null "RTN","RADRPT1",69,0) .; ^TMP($J,"RAEX",RAP)=IEN 70.3 ^ RADFN ^ Exam Date ^ inv. Exam Date (IEN 70.02) "RTN","RADRPT1",70,0) .; ^ Case Number ^ IEN EXAMINATIONS (70.03) ^ Report (if none null) "RTN","RADRPT1",71,0) .S ^TMP($J,"RAEX",RAP)=RAY_U_RADFN_U_RADTE_U_RADTI_U_RACN_U_RACNI_U_RARPT "RTN","RADRPT1",72,0) .W !,RAP,?3,RA("ACC"),?21,RA("EXDT"),?37,$E(RA("PRC"),1,16),?55,RA("CPT"),?62,$E(RA("PIS"),1,17) "RTN","RADRPT1",73,0) .I $Y>(IOSL-6) D "RTN","RADRPT1",74,0) ..S:RAY'=RA("OMEGA") RAHLP="Enter a '^' to exit or to continue." "RTN","RADRPT1",75,0) ..S:RAY=RA("OMEGA") RAHLP="Enter a '^' or to exit." "RTN","RADRPT1",76,0) ..D ASK(RAHLP) "RTN","RADRPT1",77,0) ..;straight exit '^' or timeout "RTN","RADRPT1",78,0) ..I RAR="^" S RAQ=-1 Q "RTN","RADRPT1",79,0) ..;no more data to display (user enters return) "RTN","RADRPT1",80,0) ..I RAY=RA("OMEGA"),(RAR="") S RAQ=-1 Q "RTN","RADRPT1",81,0) ..;more data to dispay, user chooses to continue "RTN","RADRPT1",82,0) ..I RAR="" D HDR Q "RTN","RADRPT1",83,0) ..;the user selected a record/list of records... "RTN","RADRPT1",84,0) ..I +RAR S RAQ=1 "RTN","RADRPT1",85,0) ..Q "RTN","RADRPT1",86,0) .Q "RTN","RADRPT1",87,0) ;now check if the user went through all the record w/o selecting "RTN","RADRPT1",88,0) ; - the user exited the loop abruptly "RTN","RADRPT1",89,0) I RAQ=-1 D XIT QUIT "RTN","RADRPT1",90,0) ; - the user fell through the loop without selecting "RTN","RADRPT1",91,0) I RAR="" S RAHLP="Enter a '^' or to exit." W ! D ASK(RAHLP) "RTN","RADRPT1",92,0) ;the user exited w/o selecting a list "RTN","RADRPT1",93,0) I RAR="^"!(RAR="") D XIT QUIT "RTN","RADRPT1",94,0) ; - the user salected "RTN","RADRPT1",95,0) I +RAR D "RTN","RADRPT1",96,0) .D DATA ;save off only the user's selections "RTN","RADRPT1",97,0) .S ZTSAVE("RADFN")="" "RTN","RADRPT1",98,0) .S ZTSAVE("^TMP($J,""RAEX"",")="",ZTRTN="EN^RADRPT1A" "RTN","RADRPT1",99,0) .S ZTDESC="RA-Radiation dosage report (Patient Profile format)" "RTN","RADRPT1",100,0) .D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1) ;"QM" w/ T6 "RTN","RADRPT1",101,0) .I $G(ZTSK) W !!,"This report has been tasked: "_ZTSK "RTN","RADRPT1",102,0) .Q "RTN","RADRPT1",103,0) D XIT "RTN","RADRPT1",104,0) Q "RTN","RADRPT1",105,0) ; "RTN","RADRPT1",106,0) HDR ;header - study selection process "RTN","RADRPT1",107,0) W @IOF,!!,$$CJ^XLFSTR(RA("HDR"),80) "RTN","RADRPT1",108,0) W !?62,"Primary" "RTN","RADRPT1",109,0) W !?3,"Accession No.",?21,"Exam Date/Time",?37,"Procedure Name",?55,"CPT",?62,"Interpreting" ;P119 Accession "RTN","RADRPT1",110,0) W !?3,"-------------",?21,"--------------",?37,"--------------",?55,"-----",?62,"------------" "RTN","RADRPT1",111,0) Q "RTN","RADRPT1",112,0) ; "RTN","RADRPT1",113,0) XIT ;kill variables set ZTREQ then exit "RTN","RADRPT1",114,0) K %,%H,%I,N,RA,RAC,RACN,RACNI,RADFN,RADTE,RADPT,RADTI,RAHLP,RAP,RAQ,RAR,RARPT,RASSN "RTN","RADRPT1",115,0) K RAX,RAY,RAY2,RAY3,RTFL,X,X1,Y,Z,ZTDESC,ZTRTN,ZTSAVE,ZTSK "RTN","RADRPT1",116,0) K ^TMP($J,"RAEX") "RTN","RADRPT1",117,0) ;S:$D(ZTQUEUED) ZTREQ="@" "RTN","RADRPT1",118,0) Q "RTN","RADRPT1",119,0) ; "RTN","RADRPT1",120,0) ASK(RAHLP) ;ask the user for a response/end of screen "RTN","RADRPT1",121,0) K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y S DIR(0)="LO^1:"_RAP_":0" "RTN","RADRPT1",122,0) S DIR("A")="Enter a number or range of numbers between 1 and "_RAP "RTN","RADRPT1",123,0) S DIR("?",1)="This response must be a list or range, e.g., 1,3,5 or 2-4,8." "RTN","RADRPT1",124,0) S DIR("?")=RAHLP D ^DIR "RTN","RADRPT1",125,0) S:$D(DTOUT)#2!($D(DUOUT)#2) Y="^" "RTN","RADRPT1",126,0) ;Y can be: '^', "" (upon ) or a value. "RTN","RADRPT1",127,0) S RAR=Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","RADRPT1",128,0) QUIT "RTN","RADRPT1",129,0) ; "RTN","RADRPT1",130,0) DATA ;Make sure only the records selected by the patient "RTN","RADRPT1",131,0) ;are preserved. "RTN","RADRPT1",132,0) ;input: RAR - the user's selections "RTN","RADRPT1",133,0) S XRAR=","_RAR,I=0 "RTN","RADRPT1",134,0) F S I=$O(^TMP($J,"RAEX",I)) Q:'I D "RTN","RADRPT1",135,0) .I XRAR'[(","_I_",") K ^TMP($J,"RAEX",I) "RTN","RADRPT1",136,0) K I,XRAR "RTN","RADRPT1",137,0) Q "RTN","RADRPT1",138,0) ; "RTN","RADRPT1",139,0) CT ;----------------------- get Rad Dose (CT SCAN) ------------------- "RTN","RADRPT1",140,0) ;called from RADRPT1A "RTN","RADRPT1",141,0) S RAHDR=$$CJ^XLFSTR("Rad Dose",IOM,"-") "RTN","RADRPT1",142,0) S RACOL("A1")="Irradiation Event",RACOL("A2")="(5 highest DLP)" "RTN","RADRPT1",143,0) s $P(RACOL("A3"),"-",($L(RACOL("A1"))+1))="" "RTN","RADRPT1",144,0) S RACOL("B1")="CTDIvol",RACOL("B2")=" (mGy)" "RTN","RADRPT1",145,0) S $P(RACOL("B3"),"-",($L(RACOL("B1"))+1))="" "RTN","RADRPT1",146,0) S RACOL("C1")="DLP",RACOL("C2")="(mGy-cm)" "RTN","RADRPT1",147,0) S $P(RACOL("C3"),"-",($L(RACOL("C2"))+1))="" "RTN","RADRPT1",148,0) ;S RACOL("E2")="Target Region",$P(RACOL("E3"),"-",($L(RACOL("E2"))+1))="" "RTN","RADRPT1",149,0) I $Y>(IOSL-6) D Q:RAQUIT "RTN","RADRPT1",150,0) .D HDR1^RADRPT1 "RTN","RADRPT1",151,0) .Q "RTN","RADRPT1",152,0) E D "RTN","RADRPT1",153,0) .W !,RAHDR D CTCOL "RTN","RADRPT1",154,0) .Q "RTN","RADRPT1",155,0) S RAB=$C(32),RAE=0,RAGJC="0^0" "RTN","RADRPT1",156,0) F S RAB=$O(^RAD(RARAD,"II","DLP",RAB),-1) Q:RAB'>0 D Q:RAQUIT "RTN","RADRPT1",157,0) .S RACC=0 F S RACC=$O(^RAD(RARAD,"II","DLP",RAB,RACC)) Q:RACC'>0 D Q:RAQUIT "RTN","RADRPT1",158,0) ..S RAII(0)=$G(^RAD(RARAD,"II",RACC,0)) Q:RAII(0)="" "RTN","RADRPT1",159,0) ..I $Y>(IOSL-4) D HDR1^RADRPT1 Q:RAQUIT "RTN","RADRPT1",160,0) ..S RAE=RAE+1 ; # IIUID records "RTN","RADRPT1",161,0) ..S RAII(2)=$$GET1^DIQ(2005.6361,+$P(RAII(0),U,2)_",",2) ;ATR - CODE MEANING fld "RTN","RADRPT1",162,0) ..S $P(RAGJC,U,1)=$P(RAGJC,U,1)+$P(RAII(0),U,4) ; CTDIvol totals "RTN","RADRPT1",163,0) ..S $P(RAGJC,U,2)=$P(RAGJC,U,2)+$P(RAII(0),U,5) ; DLP totals "RTN","RADRPT1",164,0) ..;Columns: Sequence, CTDIvol, DLP, Irradiation Type & Target Region only the top five "RTN","RADRPT1",165,0) ..;Note: Target Region column & display removed 07/11/2017 b/c of data accuracy issues T6 "RTN","RADRPT1",166,0) ..;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) "RTN","RADRPT1",167,0) ..W:RAE'>5 !?2,RAE,?24,$J($P(RAII(0),U,4),8,2),?39,$J($P(RAII(0),U,5),8,2) "RTN","RADRPT1",168,0) ..Q "RTN","RADRPT1",169,0) .Q "RTN","RADRPT1",170,0) I 'RAQUIT D "RTN","RADRPT1",171,0) .W !,"Total Exam CTDIvol: "_$J(+$P(RAGJC,U,1),8,2)_" mGy from all irradiation events." "RTN","RADRPT1",172,0) .W !,"Total Exam DLP: "_$J(+$P(RAGJC,U,2),8,2)_" mGy-cm from all irradiation events." "RTN","RADRPT1",173,0) .W !!,"Total # irradiation events: ",RAE "RTN","RADRPT1",174,0) .Q "RTN","RADRPT1",175,0) K RAB,RACC,RACOL,RAE,RAGJC,RAHD,RAII,RAIRT,RATMP,RATR "RTN","RADRPT1",176,0) Q "RTN","RADRPT1",177,0) ; "RTN","RADRPT1",178,0) CTCOL ;print CT column headers "RTN","RADRPT1",179,0) W !,RACOL("A1"),?24,RACOL("B1"),?41,RACOL("C1") "RTN","RADRPT1",180,0) ;W !,RACOL("A2"),?24,RACOL("B2"),?39,RACOL("C2"),?54,RACOL("E2") "RTN","RADRPT1",181,0) ;W !,RACOL("A3"),?24,RACOL("B3"),?39,RACOL("C3"),?54,RACOL("E3") "RTN","RADRPT1",182,0) W !,RACOL("A2"),?24,RACOL("B2"),?39,RACOL("C2") ;T6 "RTN","RADRPT1",183,0) W !,RACOL("A3"),?24,RACOL("B3"),?39,RACOL("C3") ;T6 "RTN","RADRPT1",184,0) Q "RTN","RADRPT1",185,0) ; "RTN","RADRPT1",186,0) HDR1 ;header/end of screen logic "RTN","RADRPT1",187,0) ;RAHDR: is dynamic; its value is based on the section "RTN","RADRPT1",188,0) ;HDR^RADRPT1 is called from. "RTN","RADRPT1",189,0) I $E(IOST,1,2)="C-" D Q:RAQUIT "RTN","RADRPT1",190,0) .W !,"Press RETURN to continue or '^' to exit: " R X:DTIME "RTN","RADRPT1",191,0) .S RAQUIT='$T!(X["^") K X "RTN","RADRPT1",192,0) .Q "RTN","RADRPT1",193,0) S RAPG=RAPG+1 W @IOF,!,RATITLE "RTN","RADRPT1",194,0) W !,"Date: ",RANODT,?69,"Page: ",RAPG "RTN","RADRPT1",195,0) W !,RABORDR "RTN","RADRPT1",196,0) W !?RATAB(1),"Name: ",$E(RA("NAME"),1,27)_" "_RA("BID") "RTN","RADRPT1",197,0) W ?RATAB(4),"Exam Date: ",$E(RAY2A(70.02,RAIEN,".01","E"),1,21) "RTN","RADRPT1",198,0) W !?RATAB(1),"Procedure: ",$E(RAPRC,1,30) "RTN","RADRPT1",199,0) W ?RATAB(4),"Case Number: ",RA("RACN") "RTN","RADRPT1",200,0) W !,RAHDR D CTCOL "RTN","RADRPT1",201,0) ;specifc to CT SCANS - print column data "RTN","RADRPT1",202,0) Q "RTN","RADRPT1",203,0) ; "RTN","RADRPT1A") 0^3^B114118092^B113032077 "RTN","RADRPT1A",1,0) RADRPT1A ;HISC/GJC Radiation dosage report utility one A ;01 Aug 2017 1:26 PM "RTN","RADRPT1A",2,0) ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7 "RTN","RADRPT1A",3,0) ; "RTN","RADRPT1A",4,0) ;--- IAs --- "RTN","RADRPT1A",5,0) ;Call/File Number Type "RTN","RADRPT1A",6,0) ;------------------------------------------------ "RTN","RADRPT1A",7,0) ;$$SS^%ZTLOAD 10063 S "RTN","RADRPT1A",8,0) ;$$GET1^DIQ 2056 S "RTN","RADRPT1A",9,0) ;GETS^DIQ 2056 S "RTN","RADRPT1A",10,0) ;$$FMTE^XLFDT 10103 S "RTN","RADRPT1A",11,0) ;$$NOW^XLFDT 10103 S "RTN","RADRPT1A",12,0) ;$$CJ^XLFSTR 10104 S "RTN","RADRPT1A",13,0) ;^DPT( 10035 S "RTN","RADRPT1A",14,0) ;^VA(200, 10060 S "RTN","RADRPT1A",15,0) ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private "RTN","RADRPT1A",16,0) ; "RTN","RADRPT1A",17,0) EN ;entry point "RTN","RADRPT1A",18,0) ; variables saved "RTN","RADRPT1A",19,0) ;---------------- "RTN","RADRPT1A",20,0) ; ^TMP($J,"RAEX",n)=IEN 70.3 ^ RADFN ^ Exam Date ^ inv. Exam Date (IEN 70.02) "RTN","RADRPT1A",21,0) ; ^ Case Number ^ IEN EXAMINATIONS (70.03) ^ Report (if none null) "RTN","RADRPT1A",22,0) S (RAI,RAP,RAQUIT)=0 "RTN","RADRPT1A",23,0) S RANODT=$$FMTE^XLFDT($$NOW^XLFDT(),"1M") "RTN","RADRPT1A",24,0) S RATITLE=$$CJ^XLFSTR("Patient Profile With Radiation Dose Data",IOM) "RTN","RADRPT1A",25,0) ;RAX = field numbers returned 70.03 level "RTN","RADRPT1A",26,0) S RAX=".01:4;6:8;9;9.5;12:16;19;125*" ;*** see DD map of 70.03 *** "RTN","RADRPT1A",27,0) S $P(RABORDR,"=",(IOM+1))="",$P(RALINE,"-",(IOM+1))="" "RTN","RADRPT1A",28,0) S RATAB(1)=2,RATAB(2)=14,RATAB(3)=38,RATAB(4)=49 "RTN","RADRPT1A",29,0) S RATAB(5)=16,RATAB(6)=38,RATAB(7)=51 "RTN","RADRPT1A",30,0) ; "RTN","RADRPT1A",31,0) K RAZDFN D GETS^DIQ(2,RADFN_",",".01;.09","E","RAZDFN") "RTN","RADRPT1A",32,0) S RA("NAME")=$E(RAZDFN(2,RADFN_",",".01","E"),1,30) "RTN","RADRPT1A",33,0) S X=RAZDFN(2,RADFN_",",".09","E"),RA("PID")=X "RTN","RADRPT1A",34,0) ;RA("PID") is the full SSN just like VA("PID") "RTN","RADRPT1A",35,0) S X1=$E(X,($L(X)-3),$L(X)) "RTN","RADRPT1A",36,0) ;RA("BID") is the last four of the SSN just like VA("BID") "RTN","RADRPT1A",37,0) S RA("BID")=X1 K RAZDFN,X,X1 "RTN","RADRPT1A",38,0) ; "RTN","RADRPT1A",39,0) K ^TMP($J,"RA DISCLAIMER") D DISCLAIM^RADRPT2A "RTN","RADRPT1A",40,0) ; "RTN","RADRPT1A",41,0) F S RAI=$O(^TMP($J,"RAEX",RAI)) Q:'RAI D Q:RAQUIT "RTN","RADRPT1A",42,0) .S Y=$G(^TMP($J,"RAEX",RAI)) "RTN","RADRPT1A",43,0) .F I=1:1:7 S @$P("RARAD^RADFN^RADTE^RADTI^RACN^RACNI^RARPT","^",I)=$P(Y,"^",I) "RTN","RADRPT1A",44,0) .;RARAD = IEN file 70.3; RARPT = IEN of the report for this study "RTN","RADRPT1A",45,0) .S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) Q:RAY2="" "RTN","RADRPT1A",46,0) .S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RAY3="" "RTN","RADRPT1A",47,0) .S RAORD(0)=$G(^RAO(75.1,+$P(RAY3,U,11),0)) "RTN","RADRPT1A",48,0) .;fluoro data on 0 node "RTN","RADRPT1A",49,0) .S RARAD(0)=$G(^RAD(RARAD,0)) Q:RARAD(0)="" "RTN","RADRPT1A",50,0) .S RAIEN=RADTI_","_RADFN_"," K RAY2A,RAY3A "RTN","RADRPT1A",51,0) .D GETS^DIQ(70.02,RAIEN,".01:4","E","RAY2A") "RTN","RADRPT1A",52,0) .S RAIENS=RACNI_","_RADTI_","_RADFN_"," "RTN","RADRPT1A",53,0) .D GETS^DIQ(70.03,RAIENS,RAX,"E","RAY3A") "RTN","RADRPT1A",54,0) .S RA("RACN")=$$CN() ; case # accession # "RTN","RADRPT1A",55,0) .; "RTN","RADRPT1A",56,0) .;--- header for first page only --- "RTN","RADRPT1A",57,0) .S RAPG=1 W @IOF,!,RATITLE "RTN","RADRPT1A",58,0) .W !,"Date: ",RANODT,?69,"Page: ",RAPG "RTN","RADRPT1A",59,0) .W !,RABORDR "RTN","RADRPT1A",60,0) .; "RTN","RADRPT1A",61,0) .;--- name and SSN (last four) --- "RTN","RADRPT1A",62,0) .W !?RATAB(1),"Name",?RATAB(2),": ",RA("NAME")," ",RA("BID") "RTN","RADRPT1A",63,0) .; "RTN","RADRPT1A",64,0) .W !?RATAB(1),"Division",?RATAB(2),": ",$E(RAY2A(70.02,RAIEN,"3","E"),1,21) "RTN","RADRPT1A",65,0) .W ?RATAB(3),"Category",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"4","E"),1,27) "RTN","RADRPT1A",66,0) .W !?RATAB(1),"Location",?RATAB(2),": ",$E(RAY2A(70.02,RAIEN,"4","E"),1,21) "RTN","RADRPT1A",67,0) .W ?RATAB(3),"Ward",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"6","E"),1,27) "RTN","RADRPT1A",68,0) .W !?RATAB(1),"Exam Date",?RATAB(2),": ",$E(RAY2A(70.02,RAIEN,".01","E"),1,21) "RTN","RADRPT1A",69,0) .W ?RATAB(3),"Service",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"7","E"),1,27) "RTN","RADRPT1A",70,0) .W !?RATAB(1),"Case No.",?RATAB(2),": ",$$CN() ;16 digits max "RTN","RADRPT1A",71,0) .W ?RATAB(3),"Bedsection",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"19","E"),1,27) "RTN","RADRPT1A",72,0) .W !?RATAB(3),"Clinic",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"8","E"),1,27) "RTN","RADRPT1A",73,0) .W:$E(RAY3A(70.03,RAIENS,"4","E"),1)="C" !?RATAB(3),"Contract",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"9","E"),1,27) "RTN","RADRPT1A",74,0) .W:$E(RAY3A(70.03,RAIENS,"4","E"),1)="S" !?RATAB(3),"Sharing",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"9","E"),1,27) "RTN","RADRPT1A",75,0) .W:$E(RAY3A(70.03,RAIENS,"4","E"),1)="R" !?RATAB(3),"Research",?RATAB(4),": ",$E(RAY3A(70.03,RAIENS,"9.5","E"),1,27) "RTN","RADRPT1A",76,0) .W !,RALINE ;spacer "RTN","RADRPT1A",77,0) .S RAOPRC=$$GET1^DIQ(71,+$P(RAORD(0),U,2)_",",.01) ;name of ordered proc. "RTN","RADRPT1A",78,0) .S RAPRC=$$GET1^DIQ(71,+$P(RAY3,U,2)_",",.01) ;name of registered proc. "RTN","RADRPT1A",79,0) .W !?RATAB(1),"Registered",?RATAB(2),": ",$E(RAPRC,1,30),?RATAB(4),$$PRC(+$P(RAY3,U,2)) "RTN","RADRPT1A",80,0) .W:RAPRC'=RAOPRC !?RATAB(1),"Requested",?RATAB(2),": ",$E(RAOPRC,1,60) "RTN","RADRPT1A",81,0) .S RA("PHYS")=$$GET1^DIQ(200,+$P(RAY3,U,14)_",",.01) ;name of requesting physician "RTN","RADRPT1A",82,0) .S RA("EXS")=$P($G(^RA(72,+$P(RAY3,U,3),0)),U) ;exam status "RTN","RADRPT1A",83,0) .S RA("PIR")=$$GET1^DIQ(200,+$P(RAY3,U,12)_",",.01) ;name of primary interpreting resident "RTN","RADRPT1A",84,0) .I $P(RAY3,U,17)>0 D "RTN","RADRPT1A",85,0) ..S RA("RPT")=$$GET1^DIQ(74,+$P(RAY3,U,17)_",",5) "RTN","RADRPT1A",86,0) ..S RA("RPT")=$S($G(RA("RPT"))'="":RA("RPT"),1:"No Report") "RTN","RADRPT1A",87,0) ..S RA("PREVFIER")=+$P($G(^RARPT(+$P(RAY3,U,17),0)),U,13) ;13th piece fld #15 "RTN","RADRPT1A",88,0) ..S RA("PREVFIER")=$$GET1^DIQ(200,+RA("PREVFIER")_",",.01) ;name of requesting physician "RTN","RADRPT1A",89,0) ..S RA("PREVFIED")=$S(RA("PREVFIER")'="":RA("PREVFIER"),1:"No") K RA("PREVFIER") "RTN","RADRPT1A",90,0) ..Q "RTN","RADRPT1A",91,0) .S RA("CAM")=$S(+$P(RAY3,U,18)>0:$P($G(^RA(78.6,+$P(RAY3,U,18),0)),U),1:"") ;cam/eq/rm "RTN","RADRPT1A",92,0) .S RA("PIS")=$$GET1^DIQ(200,+$P(RAY3,U,15)_",",.01) ;name of primary interpreting staff "RTN","RADRPT1A",93,0) .S RA("DX")=$S(+$P(RAY3,U,13)>0:$P($G(^RA(78.3,+$P(RAY3,U,13),0)),U),1:"") "RTN","RADRPT1A",94,0) .S RA("TECH")=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) "RTN","RADRPT1A",95,0) .I RA("TECH") D "RTN","RADRPT1A",96,0) ..S RA("T")=+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",RA("TECH"),0)),U) "RTN","RADRPT1A",97,0) ..S RA("TECH")=$$GET1^DIQ(200,RA("T")_",",.01) ;name of technologist "RTN","RADRPT1A",98,0) ..K RA("T") "RTN","RADRPT1A",99,0) ..QUIT "RTN","RADRPT1A",100,0) .S RA("CMP")=$E(RAY3A(70.03,RAIENS,"16","E"),1,27) "RTN","RADRPT1A",101,0) .W !?RATAB(1),"Requesting Phy",?RATAB(5),": ",$E(RA("PHYS"),1,18) "RTN","RADRPT1A",102,0) .W ?RATAB(6),"Exam Status",?RATAB(7),": ",$E(RA("EXS"),1,27) "RTN","RADRPT1A",103,0) .W !?RATAB(1),"Int'g Resident",?RATAB(5),": ",$E(RA("PIR"),1,18) "RTN","RADRPT1A",104,0) .W ?RATAB(6),"Report Status",?RATAB(7),": ",$E($G(RA("RPT")),1,27) "RTN","RADRPT1A",105,0) .W !?RATAB(1),"Pre-Verified",?RATAB(5),": ",$E($G(RA("PREVFIED")),1,18) "RTN","RADRPT1A",106,0) .W ?RATAB(6),"Cam/Equip/Rm",?RATAB(7),": ",$E(RA("CAM"),1,27) "RTN","RADRPT1A",107,0) .W !?RATAB(1),"Int'g Staff",?RATAB(5),": ",$E(RA("PIS"),1,18) "RTN","RADRPT1A",108,0) .W ?RATAB(6),"Diagnosis",?RATAB(7),": ",$E(RA("DX"),1,27) "RTN","RADRPT1A",109,0) .W !?RATAB(1),"Technologist",?RATAB(5),": ",$E($G(RA("TECH")),1,18) "RTN","RADRPT1A",110,0) .W ?RATAB(6),"Complication",?RATAB(7),": ",$E(RA("CMP"),1,27) "RTN","RADRPT1A",111,0) .I $P(RAORD(0),U,13)'="" W !?RATAB(1),"Pregnant at time of order entry: "_$$GET1^DIQ(75.1,+$P(RAY3,U,11)_",",13) "RTN","RADRPT1A",112,0) .; "RTN","RADRPT1A",113,0) .;--------- get procedure modifiers/CPT Modifiers --------------- "RTN","RADRPT1A",114,0) .S RALBL="Modifiers",RAHDR=$$CJ^XLFSTR(RALBL,IOM,"-") "RTN","RADRPT1A",115,0) .W !,RAHDR,!?RATAB(1),RALBL,?RATAB(5),": " "RTN","RADRPT1A",116,0) .I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"M",0)) D K RAL,RAS "RTN","RADRPT1A",117,0) ..S RAL=$O(RAY3A("70.1",$C(126)),-1) "RTN","RADRPT1A",118,0) ..S RAS="" F S RAS=$O(RAY3A("70.1",RAS)) Q:RAS="" D Q:RAQUIT "RTN","RADRPT1A",119,0) ...I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",120,0) ...W ?18,$E($G(RAY3A("70.1",RAS,.01,"E")),1,30) "RTN","RADRPT1A",121,0) ...W:RAL'=RAS ! ;more data "RTN","RADRPT1A",122,0) ...Q "RTN","RADRPT1A",123,0) ..Q "RTN","RADRPT1A",124,0) .E W "None" "RTN","RADRPT1A",125,0) .Q:RAQUIT "RTN","RADRPT1A",126,0) .S RALBL="CPT Modifiers" W !?RATAB(1),RALBL,?RATAB(5),": " "RTN","RADRPT1A",127,0) .I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CMOD",0)) D K RACPT,RAL,RALBL,RAS,RAX99,Y "RTN","RADRPT1A",128,0) ..;EX: - RACPT("70.3135","1,1,6889176.8884,76,",".01","I")=4 "RTN","RADRPT1A",129,0) ..D GETS^DIQ(70.03,RAIENS,"135*","I","RACPT") "RTN","RADRPT1A",130,0) ..S RAL=$O(RACPT("70.3135",$C(126)),-1) "RTN","RADRPT1A",131,0) ..S RAS="" F S RAS=$O(RACPT("70.3135",RAS)) Q:RAS="" D Q:RAQUIT "RTN","RADRPT1A",132,0) ...I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",133,0) ...;EX - RAX99="4^23^UNUSUAL ANESTHESIA^09923^C^2930101^1^^2930101^" "RTN","RADRPT1A",134,0) ...S Y=$G(RACPT("70.3135",RAS,.01,"I")),RAX99="" "RTN","RADRPT1A",135,0) ...S:Y RAX99=$$BASICMOD^RACPTMSC(Y,RADTE) "RTN","RADRPT1A",136,0) ...W ?18,$P(RAX99,U,2)," ",$P(RAX99,U,3) "RTN","RADRPT1A",137,0) ...W:RAL'=RAS ! "RTN","RADRPT1A",138,0) ...Q "RTN","RADRPT1A",139,0) ..Q "RTN","RADRPT1A",140,0) .E W "None" "RTN","RADRPT1A",141,0) .Q:RAQUIT "RTN","RADRPT1A",142,0) .; "RTN","RADRPT1A",143,0) .;-------------------- get Contrast Media -------------------------- "RTN","RADRPT1A",144,0) .I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0)) D K RACM,RAL,RALBL,RAS "RTN","RADRPT1A",145,0) ..S RALBL="Contrast Media",RAHDR=$$CJ^XLFSTR(RALBL,IOM,"-") "RTN","RADRPT1A",146,0) ..W !,RAHDR,!?RATAB(1),RALBL,?RATAB(5),": " "RTN","RADRPT1A",147,0) ..D GETS^DIQ(70.03,RAIENS,"225*","E","RACM") "RTN","RADRPT1A",148,0) ..S RAL=$O(RACM("70.3225",$C(126)),-1) "RTN","RADRPT1A",149,0) ..S RAS="" F S RAS=$O(RACM("70.3225",RAS)) Q:RAS="" D Q:RAQUIT "RTN","RADRPT1A",150,0) ...I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",151,0) ...W ?18,$E($G(RACM("70.3225",RAS,.01,"E")),1,30) "RTN","RADRPT1A",152,0) ...W:RAL'=RAS ! ;more data "RTN","RADRPT1A",153,0) ...Q "RTN","RADRPT1A",154,0) ..Q "RTN","RADRPT1A",155,0) .Q:RAQUIT "RTN","RADRPT1A",156,0) .; "RTN","RADRPT1A",157,0) .;----------------------- get Medications ------------------------------ "RTN","RADRPT1A",158,0) .I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"RX",0)) D K RAS,RAMED "RTN","RADRPT1A",159,0) ..S RAHDR=$$CJ^XLFSTR("Medications",IOM,"-") W !,RAHDR "RTN","RADRPT1A",160,0) ..K RAMED D GETS^DIQ(70.03,RAIENS,"200*","E","RAMED") "RTN","RADRPT1A",161,0) ..S RAL=$O(RAMED("70.15",$C(126)),-1) "RTN","RADRPT1A",162,0) ..S RAS="" F S RAS=$O(RAMED("70.15",RAS)) Q:RAS="" D Q:RAQUIT "RTN","RADRPT1A",163,0) ...I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",164,0) ...W !?RATAB(1),"Med: ",$E($G(RAMED("70.15",RAS,.01,"E")),1,28) "RTN","RADRPT1A",165,0) ...W ?RATAB(3),"Dose Adm'd: ",$E($G(RAMED("70.15",RAS,2,"E")),1,25) "RTN","RADRPT1A",166,0) ...W !?RATAB(1),"Adm'd by: ",$E($G(RAMED("70.15",RAS,3,"E")),1,24) "RTN","RADRPT1A",167,0) ...W ?RATAB(3),"Date Adm'd: ",$E($G(RAMED("70.15",RAS,4,"E")),1,20) "RTN","RADRPT1A",168,0) ...W:RAS'=RAL ! ;more data "RTN","RADRPT1A",169,0) ...Q "RTN","RADRPT1A",170,0) ..Q "RTN","RADRPT1A",171,0) .Q:RAQUIT "RTN","RADRPT1A",172,0) .; "RTN","RADRPT1A",173,0) .;----------------------- get Radiopharms ------------------------------ "RTN","RADRPT1A",174,0) .I $P(RAY3,U,28)>0 D K RADA,RADIO,RAS,RAU "RTN","RADRPT1A",175,0) ..;#500 NUCLEAR MED DATA "RTN","RADRPT1A",176,0) ..S RADA=$P(RAY3,U,28)_",",RAHDR=$$CJ^XLFSTR("Radiopharmaceuticals",IOM,"-") "RTN","RADRPT1A",177,0) ..W !,RAHDR K RADIO S RAS="" "RTN","RADRPT1A",178,0) ..D GETS^DIQ(70.2,RADA_",","100*","E","RADIO") "RTN","RADRPT1A",179,0) ..S RAL=$O(RADIO("70.21",$C(126)),-1) "RTN","RADRPT1A",180,0) ..F S RAS=$O(RADIO("70.21",RAS)) Q:RAS="" D Q:RAQUIT "RTN","RADRPT1A",181,0) ...I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",182,0) ...S RAU=0 F S RAU=$O(RADIO("70.21",RAS,RAU)) Q:RAU'>0 D Q:RAQUIT "RTN","RADRPT1A",183,0) ....I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",184,0) ....S RAU(0)=$$TRN1^RAPROD2(RAU)_$G(RADIO("70.21",RAS,RAU,"E")) "RTN","RADRPT1A",185,0) ....S RAU(0)=RAU(0)_$S(RAU=2:" mCi",RAU=4:" mCi",RAU=7:" mCi",1:"") "RTN","RADRPT1A",186,0) ....W !?RATAB(1),$E(RAU(0),1,28) "RTN","RADRPT1A",187,0) ....S RAU=$O(RADIO("70.21",RAS,RAU)) "RTN","RADRPT1A",188,0) ....S:RAU'>0 RAU=$C(32) Q:RAU=$C(32) "RTN","RADRPT1A",189,0) ....S RAU(1)=$$TRN1^RAPROD2(RAU)_$G(RADIO("70.21",RAS,RAU,"E")) "RTN","RADRPT1A",190,0) ....S RAU(1)=RAU(1)_$S(RAU=2:" mCi",RAU=4:" mCi",RAU=7:" mCi",1:"") "RTN","RADRPT1A",191,0) ....W ?RATAB(4),$E(RAU(1),1,27) "RTN","RADRPT1A",192,0) ....Q "RTN","RADRPT1A",193,0) ...W:RAS'=RAL ! ;more data "RTN","RADRPT1A",194,0) ...Q "RTN","RADRPT1A",195,0) ..Q "RTN","RADRPT1A",196,0) .Q:RAQUIT "RTN","RADRPT1A",197,0) .; "RTN","RADRPT1A",198,0) .;----------------------- get Rad Dose (fluoro) -------------------- "RTN","RADRPT1A",199,0) .I $P(RARAD(0),U,5)'=""!($P(RARAD(0),U,6)'="") D ;air kerma OR air kerma area product "RTN","RADRPT1A",200,0) ..S RAHDR=$$CJ^XLFSTR("Rad Dose",IOM,"-"),RAZFL="" "RTN","RADRPT1A",201,0) ..S RACOL(1)="Air Kerma (mGy)" "RTN","RADRPT1A",202,0) ..S RACOL(2)="Air Kerma Area Product (Gy-cm2)" "RTN","RADRPT1A",203,0) ..S RACOL(3)="Fluoro Time (min)" ;note: data is in seconds "RTN","RADRPT1A",204,0) ..W !,RAHDR "RTN","RADRPT1A",205,0) ..I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",206,0) ..W !?RATAB(1),RACOL(1),?24,RACOL(2),?60,RACOL(3) "RTN","RADRPT1A",207,0) ..S $P(XRA,"-",($L(RACOL(1))+1))="" W !?RATAB(1),XRA "RTN","RADRPT1A",208,0) ..K XRA S $P(XRA,"-",($L(RACOL(2))+1))="" W ?24,XRA "RTN","RADRPT1A",209,0) ..K XRA S $P(XRA,"-",($L(RACOL(3))+1))="" W ?60,XRA "RTN","RADRPT1A",210,0) ..W !?RATAB(1),$J($P(RARAD(0),U,5),8,2),?24,$J(+$P(RARAD(0),U,6),8,2) "RTN","RADRPT1A",211,0) ..W ?60,$J(($P(RARAD(0),U,7))/60,1,1) ;to mins to tenths "RTN","RADRPT1A",212,0) ..K RACOL,XRA "RTN","RADRPT1A",213,0) ..Q "RTN","RADRPT1A",214,0) .Q:RAQUIT "RTN","RADRPT1A",215,0) .; "RTN","RADRPT1A",216,0) .;----------------------- get Rad Dose (CT SCAN) ------------------- "RTN","RADRPT1A",217,0) .I $O(^RAD(RARAD,"II",0)) S RAZCT="" D CT^RADRPT1 ;if CT Scan data "RTN","RADRPT1A",218,0) .Q:RAQUIT "RTN","RADRPT1A",219,0) .S RAP=RAP+1 "RTN","RADRPT1A",220,0) .I $D(ZTQUEUED) S:RAP#500=0 (RAQUIT,ZTSTOP)=$$S^%ZTLOAD() "RTN","RADRPT1A",221,0) .; --- disclaimer --- "RTN","RADRPT1A",222,0) .K RALBL D HDR Q:RAQUIT "RTN","RADRPT1A",223,0) .F RAII=1:1:5 D Q:RAQUIT "RTN","RADRPT1A",224,0) ..I ($D(RAZFL)#2)=1,(($D(RAZCT)#2)=0) Q:RAII=3!(RAII=4) "RTN","RADRPT1A",225,0) ..I ($D(RAZFL)#2)=0,(($D(RAZCT)#2)=1) Q:RAII=5 "RTN","RADRPT1A",226,0) ..S RAYY=0 "RTN","RADRPT1A",227,0) ..F S RAYY=$O(^TMP($J,"RA DISCLAIMER",RAII,RAYY)) Q:RAYY'>0 D Q:RAQUIT "RTN","RADRPT1A",228,0) ...I $Y>(IOSL-4) D HDR Q:RAQUIT "RTN","RADRPT1A",229,0) ...W !,$G(^TMP($J,"RA DISCLAIMER",RAII,RAYY)) "RTN","RADRPT1A",230,0) ...Q "RTN","RADRPT1A",231,0) ..Q "RTN","RADRPT1A",232,0) .S DX=0,DY=IOSL X ^%ZOSF("XY") "RTN","RADRPT1A",233,0) .K DX,DY,RAIEN,RAIENS,RAII,RAY2A,RAY3A,RAYY,RAZCT,RAZFL,RTFL,Y,Z "RTN","RADRPT1A",234,0) .Q "RTN","RADRPT1A",235,0) D XIT "RTN","RADRPT1A",236,0) Q "RTN","RADRPT1A",237,0) ; "RTN","RADRPT1A",238,0) CN() ;return case # in the form of the accession # (SSAN aware) "RTN","RADRPT1A",239,0) N X S X=$P(RAY3,U,31) ;SITE ACCESSION NUMBER (SSAN) "RTN","RADRPT1A",240,0) S:X="" X=$E(RADTE,4,5)_$E(RADTE,6,7)_$E(RADTE,2,3)_"-"_$P(RAY3,U) "RTN","RADRPT1A",241,0) Q X "RTN","RADRPT1A",242,0) ; "RTN","RADRPT1A",243,0) HDR ;header/end of screen logic "RTN","RADRPT1A",244,0) ;RAHDR: is dynamic; its value is based on the section "RTN","RADRPT1A",245,0) ;HDR^RADRPT1A is called from. "RTN","RADRPT1A",246,0) I $E(IOST,1,2)="C-" D Q:RAQUIT "RTN","RADRPT1A",247,0) .W !,"Press RETURN to continue or '^' to exit: " R X:DTIME "RTN","RADRPT1A",248,0) .S RAQUIT='$T!(X["^") K X "RTN","RADRPT1A",249,0) .Q "RTN","RADRPT1A",250,0) S RAPG=RAPG+1 W @IOF,!,RATITLE "RTN","RADRPT1A",251,0) W !,"Date: ",RANODT,?69,"Page: ",RAPG "RTN","RADRPT1A",252,0) W !,RABORDR "RTN","RADRPT1A",253,0) W !?RATAB(1),"Name: ",$E(RA("NAME"),1,27)_" "_RA("BID") "RTN","RADRPT1A",254,0) W ?RATAB(4),"Exam Date: ",$E(RAY2A(70.02,RAIEN,".01","E"),1,21) "RTN","RADRPT1A",255,0) W !?RATAB(1),"Procedure: ",$E(RAPRC,1,30) "RTN","RADRPT1A",256,0) W ?RATAB(4),"Case Number: ",RA("RACN") "RTN","RADRPT1A",257,0) W !,RAHDR W:$D(RALBL)#2 !?RATAB(1),RALBL,": " "RTN","RADRPT1A",258,0) Q "RTN","RADRPT1A",259,0) ; "RTN","RADRPT1A",260,0) XIT ;kill variables set ZTREQ then exit "RTN","RADRPT1A",261,0) K %,%H,%I,N,RA,RABORDR,RACN,RACNI,RADA,RADFN,RADTE,RADPT,RADTI,RAHDR "RTN","RADRPT1A",262,0) K RAI,RAIEN,RAIENS,RAL,RALBL,RALINE,RAM,RAMED,RANODT,RAOPRC,RAORD,RAP,RAPG "RTN","RADRPT1A",263,0) K RAPRC,RAQUIT,RARAD,RARPT,RARX,RAS,RATAB,RATITLE,RAU,RAX,RAY,RAY2,RAY2A "RTN","RADRPT1A",264,0) K RAY3,RAY3A,RAZCT,RAZFL "RTN","RADRPT1A",265,0) K ^TMP($J,"RAEX"),^TMP($J,"RA DISCLAIMER") "RTN","RADRPT1A",266,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","RADRPT1A",267,0) Q "RTN","RADRPT1A",268,0) ; "RTN","RADRPT1A",269,0) PRC(Y) ;print procedure data (file #71) "RTN","RADRPT1A",270,0) ;Input: Y = IEN file 71 "RTN","RADRPT1A",271,0) ;Output: imaging type abbreviation - procdure type or inactive - CPT code "RTN","RADRPT1A",272,0) ; (if not a Parent or Broad procedure) "RTN","RADRPT1A",273,0) ;ex: (NM Parent) "RTN","RADRPT1A",274,0) ; (MAM Inactive) Note: may be broad or parent type "RTN","RADRPT1A",275,0) ; (CT Inactive) CPT:76361 "RTN","RADRPT1A",276,0) ; (VAS Detailed) CPT:93619 "RTN","RADRPT1A",277,0) N X "RTN","RADRPT1A",278,0) S X(0)=$G(^RAMIS(71,Y,0)),X("I")=$G(^RAMIS(71,Y,"I")) "RTN","RADRPT1A",279,0) S X("IN")=$S(X("I")="":0,DT'>X("I"):0,1:1) "RTN","RADRPT1A",280,0) S X=$P(X(0),U,6),X("CPT")="" "RTN","RADRPT1A",281,0) S X("PT")=$S(X="B":"Broad",X="D":"Detailed",X="P":"Parent",X="S":"Series",1:"Unknown") "RTN","RADRPT1A",282,0) S X=+$P(X(0),U,12) S X("IT")=$S(X=0:"Unknown",1:$P(^RA(79.2,X,0),U,3)) ;required identifier "RTN","RADRPT1A",283,0) I $E(X("PT"),1)'="B",$E(X("PT"),1)'="P" S X("CPT")="CPT:"_$P($$NAMCODE^RACPTMSC(+$P(X(0),U,9),DT),U) "RTN","RADRPT1A",284,0) S X="("_X("IT")_" "_$S(X("IN"):"Inactive",1:X("PT"))_") "_X("CPT") "RTN","RADRPT1A",285,0) Q X "RTN","RADRPT1A",286,0) ; "RTN","RADRPT2") 0^6^B68075283^B62181281 "RTN","RADRPT2",1,0) RADRPT2 ;HISC/GJC Radiation dosage report utility two ;01 Aug 2017 1:54 PM "RTN","RADRPT2",2,0) ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7 "RTN","RADRPT2",3,0) ; "RTN","RADRPT2",4,0) EN ;entry point "RTN","RADRPT2",5,0) ;--- IAs --- "RTN","RADRPT2",6,0) ;Call/File Number Type "RTN","RADRPT2",7,0) ;------------------------------------------------ "RTN","RADRPT2",8,0) ;$$GET1^DIQ 2056 S "RTN","RADRPT2",9,0) ;DIR 10026 S "RTN","RADRPT2",10,0) ;$$FMADD^XLFDT 10103 S "RTN","RADRPT2",11,0) ;$$FMTE^XLFDT 10103 S "RTN","RADRPT2",12,0) ;$$NOW^XLFDT 10103 S "RTN","RADRPT2",13,0) ;$$KSP^XUPARAM 2541 S "RTN","RADRPT2",14,0) ;EN^XUTMDEVQ 1519 S "RTN","RADRPT2",15,0) ;^DPT( 10035 S "RTN","RADRPT2",16,0) ;^DIC(4, 10060 S "RTN","RADRPT2",17,0) ;^VA(200, 10090 S "RTN","RADRPT2",18,0) ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private "RTN","RADRPT2",19,0) ; "RTN","RADRPT2",20,0) ;report specifications: sort levels "RTN","RADRPT2",21,0) ;1) Type of Report (Fluoro, CT Detailed or CT Summary) "RTN","RADRPT2",22,0) ;2) exam date range begin-end "RTN","RADRPT2",23,0) ;3) exam attribute: Patient, Pri. Interpreting Staff or Procedure (one/many/all) "RTN","RADRPT2",24,0) K DIR,DIRUT,DIROUT,DTOUT,DUOUT "RTN","RADRPT2",25,0) S DIR(0)="S^F:Fluoroscopy;D:CT Detailed;S:CT Summary" "RTN","RADRPT2",26,0) S DIR("A")="Enter a report format" "RTN","RADRPT2",27,0) S DIR("?",1)="Enter the format of the report: 'F' for a Fluoroscopy summary report" "RTN","RADRPT2",28,0) S DIR("?",2)="'D' for a detailed Cat Scan (CT) report or 'S' for a CT summary report." "RTN","RADRPT2",29,0) S DIR("?",3)="" "RTN","RADRPT2",30,0) S DIR("?")="Enter '^' to exit." "RTN","RADRPT2",31,0) D ^DIR "RTN","RADRPT2",32,0) I $D(DIRUT)#2 K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y Q "RTN","RADRPT2",33,0) S RARPTYPE=Y "RTN","RADRPT2",34,0) K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y "RTN","RADRPT2",35,0) ; "RTN","RADRPT2",36,0) ;enter a date range beginning/ending "RTN","RADRPT2",37,0) D DATE^RAUTL "RTN","RADRPT2",38,0) I '($D(BEGDATE)#2) D XIT Q ;ex: 3120112 "RTN","RADRPT2",39,0) I '($D(ENDDATE)#2) D XIT Q ;ex: 3120113 "RTN","RADRPT2",40,0) ;namespace, make sure we get all the data for this range "RTN","RADRPT2",41,0) S RABEGDT=$$FMADD^XLFDT(BEGDATE,0,0,-1,0) ;ex: 3120111.2359 "RTN","RADRPT2",42,0) S RAENDDT=ENDDATE+.2359 ;ex: 3120113.2359 "RTN","RADRPT2",43,0) S RANGE=$$FMTE^XLFDT(BEGDATE,"2DZ")_" - "_$$FMTE^XLFDT(ENDDATE,"2DZ") "RTN","RADRPT2",44,0) K BEGDATE,ENDDATE "RTN","RADRPT2",45,0) ; "RTN","RADRPT2",46,0) W @IOF K DIR,DIRUT,DIROUT,DTOUT,DUOUT "RTN","RADRPT2",47,0) S DIR(0)="S^C:CPT Code;P:Patient;R:Radiologist" "RTN","RADRPT2",48,0) S DIR("A")="Enter a filter parameter" "RTN","RADRPT2",49,0) S DIR("?",1)="Enter the final filter parameter for the report: 'C' for CPT Code" "RTN","RADRPT2",50,0) S DIR("?",2)="'P' for patient or 'R' for radiologist." "RTN","RADRPT2",51,0) S DIR("?",3)="" "RTN","RADRPT2",52,0) S DIR("?")="Enter '^' to exit." "RTN","RADRPT2",53,0) D ^DIR "RTN","RADRPT2",54,0) I $D(DIRUT)#2 D XIT Q "RTN","RADRPT2",55,0) S RAFILTR=Y "RTN","RADRPT2",56,0) K DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y "RTN","RADRPT2",57,0) ; "RTN","RADRPT2",58,0) S RAQUIT=0 "RTN","RADRPT2",59,0) D @$S(RAFILTR="C":"PROC",RAFILTR="P":"PAT",1:"STAFF") "RTN","RADRPT2",60,0) I RAQUIT D XIT Q "RTN","RADRPT2",61,0) ; "RTN","RADRPT2",62,0) K RAVAR D INIT ;get facility name, station # & VISN "RTN","RADRPT2",63,0) ; "RTN","RADRPT2",64,0) F RA="RABEGDT","RAENDDT","RANGE","RAVISN","RASTNUM","RAFAC","RAFILTR","RARPTYPE","RAQUIT" S RAVAR(RA)="" "RTN","RADRPT2",65,0) S RAX=$S(RAFILTR="R":"^TMP(""RA STFPHYSI"",$J,",RAFILTR="C":"^TMP(""RA PROCI"",$J,",1:"^TMP(""RA PATI"",$J,") "RTN","RADRPT2",66,0) S RAVAR(RAX)="" "RTN","RADRPT2",67,0) D EN^XUTMDEVQ("START^RADRPT2","Package: RA - Print the radiation dosage report",.RAVAR,"QM",1) ;T6 "RTN","RADRPT2",68,0) I +$G(ZTSK)>0 W !!,"Task Number: "_ZTSK,! "RTN","RADRPT2",69,0) D XIT "RTN","RADRPT2",70,0) QUIT "RTN","RADRPT2",71,0) ; "RTN","RADRPT2",72,0) START ;start processing "RTN","RADRPT2",73,0) K ^TMP($J,"RA SORT") "RTN","RADRPT2",74,0) ;^RADPT("AR",2920610.095,2,7079389.9049)="" "RTN","RADRPT2",75,0) ;^RADPT("AR",2920610.1035,1,7079389.8964)="" "RTN","RADRPT2",76,0) S RADTE=RABEGDT,RARUNDT=$$FMTE^XLFDT($$NOW^XLFDT(),"2PM") "RTN","RADRPT2",77,0) S RAC=9999999.9999,(RAP,RAQUIT,RAPG)=0 K ^TMP($J,"RA SORT") "RTN","RADRPT2",78,0) F S RADTE=$O(^RAD("ARAD",RADTE)) Q:RADTE'>0!(RADTE>RAENDDT) D Q:RAQUIT "RTN","RADRPT2",79,0) .S RADFN=0 F S RADFN=$O(^RAD("ARAD",RADTE,RADFN)) Q:RADFN'>0 D Q:RAQUIT "RTN","RADRPT2",80,0) ..; "RTN","RADRPT2",81,0) ..S RACN=0,RADTI=(RAC-RADTE) "RTN","RADRPT2",82,0) ..S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RADRPT2",83,0) ..; check study i-type versus the user's input "RTN","RADRPT2",84,0) ..I $$ITYPCHK(+$P(RAY2,U,2))=0 QUIT "RTN","RADRPT2",85,0) ..F S RACN=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN)) Q:RACN'>0 D Q:RAQUIT "RTN","RADRPT2",86,0) ...S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0)) "RTN","RADRPT2",87,0) ...S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RADRPT2",88,0) ...S RADIEN=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U,1) Q:RADIEN="" "RTN","RADRPT2",89,0) ...; "RTN","RADRPT2",90,0) ...; --------------------- sanity check: pointers to/from 70.3 & 70.03 ------------------- "RTN","RADRPT2",91,0) ...I $O(^RAD("ARAD",RADTE,RADFN,RACN,0))'=RADIEN Q "RTN","RADRPT2",92,0) ...; ------------------------------------------------------------------------------------- "RTN","RADRPT2",93,0) ...; "RTN","RADRPT2",94,0) ...; -------------------------------- patient sort --------------------------------------- "RTN","RADRPT2",95,0) ...I RAFILTR="P",($D(^TMP("RA PATI",$J,RADFN))\10) D "RTN","RADRPT2",96,0) ....S RASORT=$O(^TMP("RA PATI",$J,RADFN,"")) Q:RASORT="" "RTN","RADRPT2",97,0) ....D GETRDOSE K RASORT "RTN","RADRPT2",98,0) ....Q "RTN","RADRPT2",99,0) ...; ------------------------------------------------------------------------------------- "RTN","RADRPT2",100,0) ...; "RTN","RADRPT2",101,0) ...; ----------------------------- procedure/CPT sort ------------------------------------ "RTN","RADRPT2",102,0) ...I RAFILTR="C",($D(^TMP("RA PROCI",$J,+$P(RAY3,U,2)))\10) D "RTN","RADRPT2",103,0) ....S RASORT=$O(^TMP("RA PROCI",$J,+$P(RAY3,U,2),"")) Q:RASORT="" "RTN","RADRPT2",104,0) ....D GETRDOSE K RASORT "RTN","RADRPT2",105,0) ....Q "RTN","RADRPT2",106,0) ...; ------------------------------------------------------------------------------------- "RTN","RADRPT2",107,0) ...; "RTN","RADRPT2",108,0) ...; ----------------------- primary interpreting staff sort ----------------------------- "RTN","RADRPT2",109,0) ...I RAFILTR="R",($D(^TMP("RA STFPHYSI",$J,+$P(RAY3,U,15)))\10) D "RTN","RADRPT2",110,0) ....S RASORT=$O(^TMP("RA STFPHYSI",$J,+$P(RAY3,U,15),"")) Q:RASORT="" "RTN","RADRPT2",111,0) ....D GETRDOSE K RASORT "RTN","RADRPT2",112,0) ....Q "RTN","RADRPT2",113,0) ...; ------------------------------------------------------------------------------------- "RTN","RADRPT2",114,0) ...Q "RTN","RADRPT2",115,0) ..Q "RTN","RADRPT2",116,0) .Q "RTN","RADRPT2",117,0) ;display the data. if no data print the negative report and quit "RTN","RADRPT2",118,0) D DISPLAY^RADRPT2A "RTN","RADRPT2",119,0) K ^TMP($J,"RA SORT"),^TMP("RA PATI"),^TMP("RA PROCI"),^TMP("RA STFPHYSI") "RTN","RADRPT2",120,0) D XIT "RTN","RADRPT2",121,0) QUIT "RTN","RADRPT2",122,0) ; "RTN","RADRPT2",123,0) PAT ;sort by patient "RTN","RADRPT2",124,0) K ^TMP($J,"RA PAT"),^TMP("RA PATI",$J) "RTN","RADRPT2",125,0) S RADIC="^RADPT(",RADIC(0)="QEAMZ",RAUTIL="RA PAT" "RTN","RADRPT2",126,0) S RADIC("A")="Select Rad/Nuc Med Patient: ",RADIC("B")="All" "RTN","RADRPT2",127,0) S RADIC("S")="I $D(^RADPT(""EDM"",+Y))" "RTN","RADRPT2",128,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y "RTN","RADRPT2",129,0) ;Did the user select radiology patients? If not, quit "RTN","RADRPT2",130,0) I $O(^TMP($J,"RA PAT",""))="" D "RTN","RADRPT2",131,0) .S RAQUIT=1 W !!?3,$C(7),"Radiology patient data was not selected." "RTN","RADRPT2",132,0) .Q "RTN","RADRPT2",133,0) ;set ^TMP($J,"RA PAT","I",IEN_#2) "RTN","RADRPT2",134,0) E D INT($NA(^TMP($J,"RA PAT"))) "RTN","RADRPT2",135,0) Q "RTN","RADRPT2",136,0) ; "RTN","RADRPT2",137,0) PROC ;sort by procedure "RTN","RADRPT2",138,0) K ^TMP($J,"RA PROC"),^TMP("RA PROCI",$J) "RTN","RADRPT2",139,0) S RADIC="^RAMIS(71,",RADIC(0)="QEAMZ",RAUTIL="RA PROC" "RTN","RADRPT2",140,0) S RADIC("A")="Select Rad/Nuc Med Procedures: ",RADIC("B")="All" "RTN","RADRPT2",141,0) S RADIC("S")="I $$SCRPROC^RADRPT2(+Y)" "RTN","RADRPT2",142,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y "RTN","RADRPT2",143,0) ;Did the user select radiology procedures? If not, quit "RTN","RADRPT2",144,0) I $O(^TMP($J,"RA PROC",""))="" D "RTN","RADRPT2",145,0) .S RAQUIT=1 W !!?3,$C(7),"Radiology procedure data was not selected." "RTN","RADRPT2",146,0) .Q "RTN","RADRPT2",147,0) ;set ^TMP($J,"RA PROC","I",IEN_#71) "RTN","RADRPT2",148,0) E D INT($NA(^TMP($J,"RA PROC"))) "RTN","RADRPT2",149,0) Q "RTN","RADRPT2",150,0) ; "RTN","RADRPT2",151,0) SCRPROC(DA) ;screen procedures by type and if inactive. "RTN","RADRPT2",152,0) N RA71 S RA71(0)=$G(^RAMIS(71,DA,0)) "RTN","RADRPT2",153,0) ;S RA71("I")=$G(^RAMIS(71,DA,"I")) "RTN","RADRPT2",154,0) Q:"^B^P^"[("^"_$P(RA71(0),U,6)_"^") 0 "RTN","RADRPT2",155,0) ;Q:$L(RA71("I"))&(RA71("I")'>DT) 0 "RTN","RADRPT2",156,0) Q 1 "RTN","RADRPT2",157,0) ; "RTN","RADRPT2",158,0) STAFF ;sort by primary interpreting staff (radiologist) "RTN","RADRPT2",159,0) K ^TMP($J,"RA STFPHYS"),^TMP("RA STFPHYSI",$J) "RTN","RADRPT2",160,0) S RADIC="^VA(200,",RADIC(0)="QEAMZ",RAUTIL="RA STFPHYS" "RTN","RADRPT2",161,0) S RADIC("A")="Select Radiologist: ",RADIC("B")="All" "RTN","RADRPT2",162,0) S RADIC("S")="I $D(^VA(200,""ARC"",""S"",+Y))\10" "RTN","RADRPT2",163,0) W !! D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,RADIC,RAUTIL,X,Y "RTN","RADRPT2",164,0) ;Did the user select staff radiologists? If not, quit "RTN","RADRPT2",165,0) I $O(^TMP($J,"RA STFPHYS",""))="" D "RTN","RADRPT2",166,0) .S RAQUIT=1 W !!?3,$C(7),"Staff Radiologist data was not selected." "RTN","RADRPT2",167,0) .Q "RTN","RADRPT2",168,0) ;set ^TMP($J,"RA STFPHYS","I",IEN_#200) "RTN","RADRPT2",169,0) E D INT($NA(^TMP($J,"RA STFPHYS"))) "RTN","RADRPT2",170,0) Q "RTN","RADRPT2",171,0) ; "RTN","RADRPT2",172,0) INT(ROOT) ;store the internal value of the patient/procedure/radiologist record "RTN","RADRPT2",173,0) N X,Y S X="" "RTN","RADRPT2",174,0) F S X=$O(@ROOT@(X)) Q:X="" D "RTN","RADRPT2",175,0) .S Y=0 F S Y=$O(@ROOT@(X,Y)) Q:Y'>0 D "RTN","RADRPT2",176,0) ..S:RAFILTR="C" ^TMP("RA PROCI",$J,Y,X)="" "RTN","RADRPT2",177,0) ..S:RAFILTR="P" ^TMP("RA PATI",$J,Y,X)="" "RTN","RADRPT2",178,0) ..S:RAFILTR="R" ^TMP("RA STFPHYSI",$J,Y,X)="" "RTN","RADRPT2",179,0) ..Q "RTN","RADRPT2",180,0) .K @ROOT@(X) "RTN","RADRPT2",181,0) .Q "RTN","RADRPT2",182,0) Q "RTN","RADRPT2",183,0) ; "RTN","RADRPT2",184,0) INIT ;initialize some variables "RTN","RADRPT2",185,0) ;return facility name (RAFAC), station # (RASTNUM) & VISN # (RAVISN) "RTN","RADRPT2",186,0) K RAR,X S RAY=$$KSP^XUPARAM("INST")_"," "RTN","RADRPT2",187,0) D GETS^DIQ(4,RAY,".01;14*;99","E","RAR") "RTN","RADRPT2",188,0) S RAFAC=RAR(4,RAY,.01,"E") ; Name of facility "RTN","RADRPT2",189,0) S RASTNUM=RAR(4,RAY,99,"E") ; Station Number "RTN","RADRPT2",190,0) K RAR,RAY,X "RTN","RADRPT2",191,0) Q "RTN","RADRPT2",192,0) ; "RTN","RADRPT2",193,0) GETRDOSE ;get Rad dosage data "RTN","RADRPT2",194,0) I RARPTYPE="F" D Q "RTN","RADRPT2",195,0) .S X=$G(^RAD(RADIEN,0)) "RTN","RADRPT2",196,0) .S RAK=$P(X,U,5),RAKAP=$P(X,U,6) "RTN","RADRPT2",197,0) .S RAFLSEC=$P(X,U,7),RAFLMIN=$J((RAFLSEC/60),5,1) "RTN","RADRPT2",198,0) .;^("F") = air kerma ^ air kerma area product ^ total fluoro time (mins) "RTN","RADRPT2",199,0) .S ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"F")=RAK_U_RAKAP_U_RAFLMIN "RTN","RADRPT2",200,0) .K RAFLMIN,RAFLSEC,RAK,RAKAP,X "RTN","RADRPT2",201,0) .Q "RTN","RADRPT2",202,0) ;check sub-file for CT data "RTN","RADRPT2",203,0) I $O(^RAD(RADIEN,"II",0)) D "RTN","RADRPT2",204,0) .K RADLP,RAII,I,X,Y S X="0^0" "RTN","RADRPT2",205,0) .; ^("S") = CTDIvol (total) ^ DLP (total) "RTN","RADRPT2",206,0) .S ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S")="0^0",RADLP=$C(32),I=0 "RTN","RADRPT2",207,0) .;get "top five" total all CTDIvol & DLP values "RTN","RADRPT2",208,0) .;formula: CTDIvol=DLP/length of scan (mGy-cm) "RTN","RADRPT2",209,0) .F S RADLP=$O(^RAD(RADIEN,"II","DLP",RADLP),-1) Q:RADLP'>0 D Q:RAQUIT "RTN","RADRPT2",210,0) ..S Y=0 F S Y=$O(^RAD(RADIEN,"II","DLP",RADLP,Y)) Q:Y'>0 D Q:RAQUIT "RTN","RADRPT2",211,0) ...S RAII(0)=$G(^RAD(RADIEN,"II",Y,0)) Q:RAII(0)="" "RTN","RADRPT2",212,0) ...S I=I+1 "RTN","RADRPT2",213,0) ...S:I'>5 ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,I)=$P(RAII(0),U,3,5) "RTN","RADRPT2",214,0) ...S $P(X,U,1)=$P(X,U,1)+$P(RAII(0),U,4) ;CTDIvol "RTN","RADRPT2",215,0) ...S $P(X,U,2)=$P(X,U,2)+$P(RAII(0),U,5) ;DLP "RTN","RADRPT2",216,0) ...Q "RTN","RADRPT2",217,0) ..Q "RTN","RADRPT2",218,0) .S ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S")=X "RTN","RADRPT2",219,0) .K RADLP,RAII,I,X,Y "RTN","RADRPT2",220,0) .Q "RTN","RADRPT2",221,0) Q "RTN","RADRPT2",222,0) ; "RTN","RADRPT2",223,0) ITYPCHK(Y) ;i-type check "RTN","RADRPT2",224,0) ;input: 'Y' = IEN imaging type of the study "RTN","RADRPT2",225,0) ;output: 0 - if the study is of a different i-type than "RTN","RADRPT2",226,0) ; the report type selected by the user (saved "RTN","RADRPT2",227,0) ; in RARPTYPE) "RTN","RADRPT2",228,0) ; 1 - if the study is the same i-type as the "RTN","RADRPT2",229,0) ; report type selected by the user "RTN","RADRPT2",230,0) ; "RTN","RADRPT2",231,0) ; 'RARPRTYPE' is a local variable of global scope. Values "RTN","RADRPT2",232,0) ; can be: 'F' for Fluoro (GEN RAD), 'D' for CT (detailed "RTN","RADRPT2",233,0) ; rpt) or 'S' for CT (summary rpt) "RTN","RADRPT2",234,0) ; "RTN","RADRPT2",235,0) ; 'RAY2' is the value if the zero node of 70.02. The "RTN","RADRPT2",236,0) ; second piece is a pointer field pointing to the "RTN","RADRPT2",237,0) ; IMAGING TYPE (#79.2) file. "RTN","RADRPT2",238,0) ; "RTN","RADRPT2",239,0) N X S X=$G(^RA(79.2,Y,0)) "RTN","RADRPT2",240,0) S X(3)=$P(X,U,3) ;match against abbrv "RTN","RADRPT2",241,0) I RARPTYPE="F",(X(3)="RAD") Q 1 "RTN","RADRPT2",242,0) I RARPTYPE="D",(X(3)="CT") Q 1 "RTN","RADRPT2",243,0) I RARPTYPE="S",(X(3)="CT") Q 1 "RTN","RADRPT2",244,0) Q 0 "RTN","RADRPT2",245,0) ; "RTN","RADRPT2",246,0) XIT ;kill variables "RTN","RADRPT2",247,0) K %,DF,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RA,RABEGDT,RAC,RACNI,RADFN,RADIEN,RADTE,RADTI,RAENDDT "RTN","RADRPT2",248,0) K RAFAC,RAFILTR,RAP,RAPG,RAPOP,RANGE,RAQUIT,RAR,RARPTYPE,RARUNDT,RASORT,RASTNUM,RAUTIL "RTN","RADRPT2",249,0) K RAVAR,RAX,RAY,RAY2,RAY3,X,Y,ZTDESC,ZTSAVE,ZTSK "RTN","RADRPT2",250,0) Q "RTN","RADRPT2",251,0) ; "RTN","RADRPT2A") 0^5^B115224298^B96661088 "RTN","RADRPT2A",1,0) RADRPT2A ;HISC/GJC Radiation dosage report utility two ;01 Aug 2017 1:28 PM "RTN","RADRPT2A",2,0) ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7 "RTN","RADRPT2A",3,0) ; "RTN","RADRPT2A",4,0) ;--- IAs --- "RTN","RADRPT2A",5,0) ;Call Number Type "RTN","RADRPT2A",6,0) ;------------------------------------------------ "RTN","RADRPT2A",7,0) ;$$SS^%ZTLOAD 10063 S "RTN","RADRPT2A",8,0) ;$$GET1^DIQ 2056 S "RTN","RADRPT2A",9,0) ;GETS^DIQ 2056 S "RTN","RADRPT2A",10,0) ;$$FMTE^XLFDT 10103 S "RTN","RADRPT2A",11,0) ;$$CJ^XLFSTR 10104 S "RTN","RADRPT2A",12,0) ;^DPT( 10035 S "RTN","RADRPT2A",13,0) ;^DIC(4, 10060 S "RTN","RADRPT2A",14,0) ;^VA(200, 10090 S "RTN","RADRPT2A",15,0) ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private "RTN","RADRPT2A",16,0) ; "RTN","RADRPT2A",17,0) DISPLAY ; display data "RTN","RADRPT2A",18,0) ; "RTN","RADRPT2A",19,0) ; Where the data for the report is stored: "RTN","RADRPT2A",20,0) ; ---------------------------------------------------------------------------- "RTN","RADRPT2A",21,0) ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"F") = Air Kerma ^ Air kerma Area Product ^ Total Fluoro time (min) "RTN","RADRPT2A",22,0) ; "RTN","RADRPT2A",23,0) ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S") = CTDIvol (total) ^ DLP (total) "RTN","RADRPT2A",24,0) ; "RTN","RADRPT2A",25,0) ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,n) = Phantom ptr (#2005.6362) ^ CTDIvol ^ DLP "RTN","RADRPT2A",26,0) ; ---------------------------------------------------------------------------- "RTN","RADRPT2A",27,0) ; "RTN","RADRPT2A",28,0) ;RARPTYPE=F:Fluoroscopy;D:Detailed;S:Summary "RTN","RADRPT2A",29,0) ;RAFILTR=C:CPT Code;P:Patient;R:Radiologist "RTN","RADRPT2A",30,0) ; "RTN","RADRPT2A",31,0) S $P(RABORDER,"=",(IOM+1))="" "RTN","RADRPT2A",32,0) S RAHDRBY=$S(RAFILTR="C":"CPT Code",RAFILTR="P":"Patient",1:"Radiologist") "RTN","RADRPT2A",33,0) S:RARPTYPE="S" RAHDRTY="CT Totals (ONLY) Radiation Dose Summary Report by "_RAHDRBY "RTN","RADRPT2A",34,0) S:RARPTYPE="D" RAHDRTY="CT by Series Radiation Dose Summary Report by "_RAHDRBY "RTN","RADRPT2A",35,0) S:RARPTYPE="F" RAHDRTY="Fluoro Radiation Dose Summary Report by "_RAHDRBY "RTN","RADRPT2A",36,0) S $P(RALINE,"-",(IOM+1))="" "RTN","RADRPT2A",37,0) S RAC=9999999.9999,(RAPG,RAQUIT,RAZTSTOP)=0 "RTN","RADRPT2A",38,0) ; "RTN","RADRPT2A",39,0) I ($D(^TMP($J,"RA SORT"))\10)=0 D D XIT Q "RTN","RADRPT2A",40,0) .D HDR S X="There are no Radiology exam records of file for the selected filter criteria." "RTN","RADRPT2A",41,0) .W !,$$CJ^XLFSTR(X,(IOM+1)) "RTN","RADRPT2A",42,0) .Q "RTN","RADRPT2A",43,0) ; "RTN","RADRPT2A",44,0) K ^TMP($J,"RA DISCLAIMER") D DISCLAIM "RTN","RADRPT2A",45,0) ; "RTN","RADRPT2A",46,0) S RADTE("X")=$O(^TMP($J,"RA SORT",$C(32)),-1) ;last date/time subscript value "RTN","RADRPT2A",47,0) S RADTE=0 D HDR "RTN","RADRPT2A",48,0) F S RADTE=$O(^TMP($J,"RA SORT",RADTE)) Q:RADTE'>0 D Q:RAQUIT "RTN","RADRPT2A",49,0) .;RAXY("X") is the last ascending second level subscript value "RTN","RADRPT2A",50,0) .S RAXY="",RAXY("X")=$O(^TMP($J,"RA SORT",RADTE,$C(126)),-1) "RTN","RADRPT2A",51,0) .F S RAXY=$O(^TMP($J,"RA SORT",RADTE,RAXY)) Q:RAXY="" D Q:RAQUIT "RTN","RADRPT2A",52,0) ..S RADFN=0,RADFN("X")=$O(^TMP($J,"RA SORT",RADTE,RAXY,$C(32)),-1) "RTN","RADRPT2A",53,0) ..F S RADFN=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN)) Q:RADFN'>0 D Q:RAQUIT "RTN","RADRPT2A",54,0) ...;get patient demographics name & SSN "RTN","RADRPT2A",55,0) ...D GETDEM S RACNI=0 "RTN","RADRPT2A",56,0) ...S RACNI("X")=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,$C(32)),-1) "RTN","RADRPT2A",57,0) ...F S RACNI=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI)) Q:RACNI'>0 D Q:RAQUIT "RTN","RADRPT2A",58,0) ....S RADTI=(RAC-RADTE),RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RADRPT2A",59,0) ....S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RADRPT2A",60,0) ....;get exam/study based data "RTN","RADRPT2A",61,0) ....D GETXAM "RTN","RADRPT2A",62,0) ....;print by Fluoroscopy "RTN","RADRPT2A",63,0) ....D:RARPTYPE="F" PRTFL Q:RAQUIT "RTN","RADRPT2A",64,0) ....;print by CT summary "RTN","RADRPT2A",65,0) ....D:RARPTYPE="S" CTDATA Q:RAQUIT "RTN","RADRPT2A",66,0) ....;print by CT detail "RTN","RADRPT2A",67,0) ....D:RARPTYPE="D" CTDATA Q:RAQUIT "RTN","RADRPT2A",68,0) ....I $Y>(IOSL-4),(RACNI'=RACNI("X")) D EOS "RTN","RADRPT2A",69,0) ....Q "RTN","RADRPT2A",70,0) ...Q:RAQUIT I $Y>(IOSL-4),(RADFN'=RADFN("X")) D EOS "RTN","RADRPT2A",71,0) ...Q "RTN","RADRPT2A",72,0) ..Q:RAQUIT I $Y>(IOSL-4),(RAXY'=RAXY("X")) D EOS "RTN","RADRPT2A",73,0) ..Q "RTN","RADRPT2A",74,0) .; RAP used as timing mechanism to check if the job was stopped "RTN","RADRPT2A",75,0) .Q:RAQUIT S RAZTSTOP=RAZTSTOP+1 "RTN","RADRPT2A",76,0) .I $D(ZTQUEUED) S:RAZTSTOP#500=0 (RAQUIT,ZTSTOP)=$$S^%ZTLOAD() "RTN","RADRPT2A",77,0) .I $Y>(IOSL-4),(RADTE'=RADTE("X")) D EOS "RTN","RADRPT2A",78,0) .Q "RTN","RADRPT2A",79,0) ; "RTN","RADRPT2A",80,0) I RAQUIT D XIT Q "RTN","RADRPT2A",81,0) S RADISCLM="" "RTN","RADRPT2A",82,0) D:$Y>(IOSL-4) EOS Q:RAQUIT "RTN","RADRPT2A",83,0) W ! F RAI=1:1:5 D Q:RAQUIT "RTN","RADRPT2A",84,0) .I RARPTYPE="F" Q:RAI=3!(RAI=4) "RTN","RADRPT2A",85,0) .I RARPTYPE="S" Q:RAI=3!(RAI=5) "RTN","RADRPT2A",86,0) .I RARPTYPE="D" Q:RAI=5 "RTN","RADRPT2A",87,0) .S RAY=0 "RTN","RADRPT2A",88,0) .F S RAY=$O(^TMP($J,"RA DISCLAIMER",RAI,RAY)) Q:RAY'>0 D Q:RAQUIT "RTN","RADRPT2A",89,0) ..D:$Y>(IOSL-4) EOS Q:RAQUIT "RTN","RADRPT2A",90,0) ..W !,$G(^TMP($J,"RA DISCLAIMER",RAI,RAY)) "RTN","RADRPT2A",91,0) ..Q "RTN","RADRPT2A",92,0) .Q:RAQUIT W ! ;break between disclaimers "RTN","RADRPT2A",93,0) .Q "RTN","RADRPT2A",94,0) D XIT "RTN","RADRPT2A",95,0) Q "RTN","RADRPT2A",96,0) ; "RTN","RADRPT2A",97,0) XIT ;kill variables and exit... "RTN","RADRPT2A",98,0) K ^TMP($J,"RA DISCLAIMER"),RA71,RABORDER,RAC,RACN,RACNI,RACPT,RACTDI,RADATE "RTN","RADRPT2A",99,0) K RADFN,RADIEN,RADISCLM,RADLP,RADTE,RADTI,RAF,RAFAC,RAFILTR,RAFLMIN,RAFLSEC "RTN","RADRPT2A",100,0) K RAHDRBY,RAHDRTY,RAHDS,RAI,RAK,RAKAP,RAL,RALINE,RANAME,RANGE,RAPG,RAPHNTOM "RTN","RADRPT2A",101,0) K RAPRC,RAQUIT,RAR,RARPTYPE,RARUNDT,RASSN,RASTF,RASTNUM,RATMP,RAXY,RAY,RAY2 "RTN","RADRPT2A",102,0) K RAY3,RAZTSTOP,X,Y S:$D(ZTQUEUED) ZTREQ="@" "RTN","RADRPT2A",103,0) Q "RTN","RADRPT2A",104,0) ; "RTN","RADRPT2A",105,0) CTDATA ;print CT detailed series data or print summary totals "RTN","RADRPT2A",106,0) ; "RTN","RADRPT2A",107,0) ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,"S") = CTDIvol (total) ^ DLP (total) "RTN","RADRPT2A",108,0) ; "RTN","RADRPT2A",109,0) ; ^TMP($J,"RA SORT",RADTE,RASORT,RADFN,RACNI,RAI) = Phantom ptr (#2005.6362) ^ CTDIvol ^ DLP "RTN","RADRPT2A",110,0) ; "RTN","RADRPT2A",111,0) N RACTDI,RADLP,RAF,RAHDS,RAI,RAPHNTOM,X "RTN","RADRPT2A",112,0) I RARPTYPE="D" D Q:RAQUIT "RTN","RADRPT2A",113,0) .S RAHDS=0 ;print the 'high 5' "RTN","RADRPT2A",114,0) .F S RAHDS=$O(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,RAHDS)) Q:RAHDS'>0 D Q:RAQUIT "RTN","RADRPT2A",115,0) ..S RAF=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,RAHDS)) "RTN","RADRPT2A",116,0) ..S RAPHNTOM=$$GET1^DIQ(2005.6362,+$P(RAF,U,1)_",",2) "RTN","RADRPT2A",117,0) ..S RACTDI=$P(RAF,U,2),RADLP=$P(RAF,U,3) "RTN","RADRPT2A",118,0) ..D PRTCTD I $Y>(IOSL-4) D EOS Q:RAQUIT "RTN","RADRPT2A",119,0) ..Q "RTN","RADRPT2A",120,0) .;print totals for the detailed report "RTN","RADRPT2A",121,0) .Q:RAQUIT "RTN","RADRPT2A",122,0) .S X=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,"S")) "RTN","RADRPT2A",123,0) .S RAHDS="Total",RACTDI=$P(X,U,1),RADLP=$P(X,U,2) "RTN","RADRPT2A",124,0) .S RAPHNTOM="" D PRTCTD "RTN","RADRPT2A",125,0) .Q "RTN","RADRPT2A",126,0) I RARPTYPE="S" D Q:RAQUIT "RTN","RADRPT2A",127,0) .S X=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,"S")) "RTN","RADRPT2A",128,0) .S RACTDI=$P(X,U,1),RADLP=$P(X,U,2) "RTN","RADRPT2A",129,0) .D PRTCTS I $Y>(IOSL-4) D EOS Q:RAQUIT "RTN","RADRPT2A",130,0) .Q "RTN","RADRPT2A",131,0) Q "RTN","RADRPT2A",132,0) ; "RTN","RADRPT2A",133,0) GETDEM ;get patient demographics name & SSN "RTN","RADRPT2A",134,0) K RATMP,X D GETS^DIQ(2,RADFN_",",".01;.09","E","RATMP") "RTN","RADRPT2A",135,0) S RANAME=RATMP(2,RADFN_",",".01","E") "RTN","RADRPT2A",136,0) S (RASSN("PID"),X)=RATMP(2,RADFN_",",".09","E") "RTN","RADRPT2A",137,0) S RASSN("BID")=$E(X,($L(X)-3),$L(X)) K RATMP,X "RTN","RADRPT2A",138,0) Q "RTN","RADRPT2A",139,0) ; "RTN","RADRPT2A",140,0) GETXAM ;get exam/study based data "RTN","RADRPT2A",141,0) S RASTF=$$GET1^DIQ(200,+$P(RAY3,U,15)_",",.01) "RTN","RADRPT2A",142,0) S RA71(0)=$G(^RAMIS(71,+$P(RAY3,U,2),0)) "RTN","RADRPT2A",143,0) S RAPRC=$P(RA71(0),U,1),RA71(9)=+$P(RA71(0),U,9) "RTN","RADRPT2A",144,0) ;Example: 73000^X-RAY EXAM OF COLLAR BONE "RTN","RADRPT2A",145,0) S RACPT=$P($$NAMCODE^RACPTMSC(RA71(9),RADTE),U,1) "RTN","RADRPT2A",146,0) S RADATE=$$FMTE^XLFDT(RADTE,"2DZ") "RTN","RADRPT2A",147,0) Q "RTN","RADRPT2A",148,0) ; "RTN","RADRPT2A",149,0) PRTCTS ;print CT summary data "RTN","RADRPT2A",150,0) W !,$E(RANAME,1,27),?29,RASSN("BID"),?35,RADATE,?45,RACPT,?52,$E(RAPRC,1,27),?81,$E(RASTF,1,27) "RTN","RADRPT2A",151,0) W ?110,$J(RACTDI,9,2),?121,$J(RADLP,9,2) "RTN","RADRPT2A",152,0) Q "RTN","RADRPT2A",153,0) ; "RTN","RADRPT2A",154,0) PRTCTD ;print CT series/detailed data "RTN","RADRPT2A",155,0) W !,$E(RANAME,1,23),?25,RASSN("BID"),?31,RADATE,?41,RACPT,?48,$E(RAPRC,1,23),?73,$E(RASTF,1,23) "RTN","RADRPT2A",156,0) W ?98,RAHDS,?107,$J(RACTDI,9,2),?118,$J(RADLP,9,2) "RTN","RADRPT2A",157,0) Q "RTN","RADRPT2A",158,0) ; "RTN","RADRPT2A",159,0) PRTFL ;print fluoroscopy data "RTN","RADRPT2A",160,0) S X=$G(^TMP($J,"RA SORT",RADTE,RAXY,RADFN,RACNI,"F")) "RTN","RADRPT2A",161,0) S RAK=$P(X,U,1),RAKAP=$P(X,U,2),RAFLMIN=$P(X,U,3) "RTN","RADRPT2A",162,0) W !,$E(RANAME,1,18),?25,RASSN("BID"),?31,RADATE,?41,RACPT,?48,$E(RAPRC,1,25),?75,$E(RASTF,1,23) "RTN","RADRPT2A",163,0) W ?99,$J(RAK,10,2),?112,$J(RAKAP,9,2),?125,RAFLMIN K X "RTN","RADRPT2A",164,0) Q "RTN","RADRPT2A",165,0) ; "RTN","RADRPT2A",166,0) EOS ;end of screen - Note: EOS falls through to HDR! "RTN","RADRPT2A",167,0) I $E(IOST,1,2)="C-" D Q:RAQUIT "RTN","RADRPT2A",168,0) .W !,"Press RETURN to continue or '^' to exit: " R X:DTIME "RTN","RADRPT2A",169,0) .S RAQUIT='$T!(X["^") K X "RTN","RADRPT2A",170,0) .Q "RTN","RADRPT2A",171,0) HDR ;header "RTN","RADRPT2A",172,0) S RAPG=RAPG+1 "RTN","RADRPT2A",173,0) W @IOF,!,"Facility",?20,": ",RAFAC,?120,"Page: ",RAPG "RTN","RADRPT2A",174,0) W !,"Station",?20,": ",RASTNUM "RTN","RADRPT2A",175,0) W !,"Report Date Range",?20,": ",RANGE "RTN","RADRPT2A",176,0) W !,"Report Run Date/Time",?20,": ",RARUNDT "RTN","RADRPT2A",177,0) W !,RABORDER D:('$D(RADISCLM)#2) @$S(RARPTYPE="F":"HDRFL",RARPTYPE="D":"HDRCTD",1:"HDRCTS") "RTN","RADRPT2A",178,0) Q "RTN","RADRPT2A",179,0) ; "RTN","RADRPT2A",180,0) HDRCTD ;header for CT detailed "RTN","RADRPT2A",181,0) W !,RAHDRTY ;note: RAHDRTY is set at top of the routine "RTN","RADRPT2A",182,0) W !!?98,"Highest",!?98,"Dose",?107,"CTDIvol",?118,"DLP" "RTN","RADRPT2A",183,0) W !,"Patient",?25,"SSN",?31,"Date",?41,"CPT",?48,"Procedure Name",?73,"Radiologist",?98,"Series",?107,"mGy",?118,"mGy-cm" "RTN","RADRPT2A",184,0) W !,RALINE "RTN","RADRPT2A",185,0) Q "RTN","RADRPT2A",186,0) ; "RTN","RADRPT2A",187,0) HDRCTS ;header for CT summary "RTN","RADRPT2A",188,0) W !,RAHDRTY "RTN","RADRPT2A",189,0) W !!?110,"Sum of",?121,"Sum of",!,?110,"all CDTI",?121,"all DLP" "RTN","RADRPT2A",190,0) W !,"Patient",?29,"SSN",?35,"Date",?45,"CPT",?52,"Procedure Name",?81,"Radiologist",?110,"vol mGy",?121,"mGy-cm" "RTN","RADRPT2A",191,0) W !,RALINE "RTN","RADRPT2A",192,0) Q "RTN","RADRPT2A",193,0) ; "RTN","RADRPT2A",194,0) HDRFL ;header for fluoroscopy "RTN","RADRPT2A",195,0) W !,RAHDRTY "RTN","RADRPT2A",196,0) W !?100,"Air",?112,"Air Kerma",?125,"Fluoro",!?100,"Kerma",?112,"Area Product",?125,"Time" "RTN","RADRPT2A",197,0) W !,"Patient",?25,"SSN",?31,"Date",?41,"CPT",?48,"Procedure Name",?75,"Radiologist",?100,"mGy",?112,"Gy-cm2",?125,"min" "RTN","RADRPT2A",198,0) W !,RALINE "RTN","RADRPT2A",199,0) Q "RTN","RADRPT2A",200,0) ; "RTN","RADRPT2A",201,0) DISCLAIM ;set up the disclaimer statements in an array "RTN","RADRPT2A",202,0) S ^TMP($J,"RA DISCLAIMER",1,1)="1. The purpose of this report is to facilitate tracking of procedure doses to" "RTN","RADRPT2A",203,0) S ^TMP($J,"RA DISCLAIMER",1,2)=" identify opportunities for improvement. It is not intended to provide a" "RTN","RADRPT2A",204,0) S ^TMP($J,"RA DISCLAIMER",1,3)=" complete record of patient dose. Doses resulting from plain films and" "RTN","RADRPT2A",205,0) S ^TMP($J,"RA DISCLAIMER",1,4)=" radiopharmaceuticals are not supported." "RTN","RADRPT2A",206,0) ;(1,5)="" "RTN","RADRPT2A",207,0) S ^TMP($J,"RA DISCLAIMER",2,1)="2. Only procedures for which dose data has been received are listed. Data may" "RTN","RADRPT2A",208,0) S ^TMP($J,"RA DISCLAIMER",2,2)=" be missing if the modality does not support DICOM structured dose reporting," "RTN","RADRPT2A",209,0) S ^TMP($J,"RA DISCLAIMER",2,3)=" if the dose report was not sent to VistA Imaging, if the radiology report was" "RTN","RADRPT2A",210,0) S ^TMP($J,"RA DISCLAIMER",2,4)=" was not verified, or if the procedure was performed/imported before patches" "RTN","RADRPT2A",211,0) S ^TMP($J,"RA DISCLAIMER",2,5)=" MAG*3*137 and RA*5*113 were installed." "RTN","RADRPT2A",212,0) ;(2,6)="" "RTN","RADRPT2A",213,0) S ^TMP($J,"RA DISCLAIMER",3,1)="3. Only the five highest dose CT series are listed. The total dose refers" "RTN","RADRPT2A",214,0) S ^TMP($J,"RA DISCLAIMER",3,2)=" to the sum of all series and so may be larger than the sum of the five" "RTN","RADRPT2A",215,0) S ^TMP($J,"RA DISCLAIMER",3,3)=" displayed doses. This report may include CT localizer radiograph(s)" "RTN","RADRPT2A",216,0) S ^TMP($J,"RA DISCLAIMER",3,4)=" values as a series and/or included in the total depending on the CT" "RTN","RADRPT2A",217,0) S ^TMP($J,"RA DISCLAIMER",3,5)=" manufacturer." "RTN","RADRPT2A",218,0) ;(3,6)="" "RTN","RADRPT2A",219,0) S ^TMP($J,"RA DISCLAIMER",4,1)="4. Radiology set workflow may show the total rad dose for a patient care event" "RTN","RADRPT2A",220,0) S ^TMP($J,"RA DISCLAIMER",4,2)=" under one CPT. If separate exposure instances during a CT examination were" "RTN","RADRPT2A",221,0) S ^TMP($J,"RA DISCLAIMER",4,3)=" of different body parts, the total CTDIvol stated here may exceed the actual" "RTN","RADRPT2A",222,0) S ^TMP($J,"RA DISCLAIMER",4,4)=" CTDIvol for any body part. More detailed dose information is available on the" "RTN","RADRPT2A",223,0) S ^TMP($J,"RA DISCLAIMER",4,5)=" modality (until it is deleted) or in the DICOM Radiation Dose Structured" "RTN","RADRPT2A",224,0) S ^TMP($J,"RA DISCLAIMER",4,6)=" Report (RDSR) file stored in VistA Imaging. Viewing the RDSR file is not yet" "RTN","RADRPT2A",225,0) S ^TMP($J,"RA DISCLAIMER",4,7)=" supported." "RTN","RADRPT2A",226,0) ;(4,8)="" "RTN","RADRPT2A",227,0) S ^TMP($J,"RA DISCLAIMER",5,1)="5. Radiology set workflow may show the total rad dose for a patient care event" "RTN","RADRPT2A",228,0) S ^TMP($J,"RA DISCLAIMER",5,2)=" under one CPT. Air Kerma Area Product is also called the Dose Area Product." "RTN","RADRPT2A",229,0) S ^TMP($J,"RA DISCLAIMER",5,3)=" If fluoroscopy was performed using more than one projection, the total air" "RTN","RADRPT2A",230,0) S ^TMP($J,"RA DISCLAIMER",5,4)=" kerma stated here may exceed the air kerma to any single projection. More" "RTN","RADRPT2A",231,0) S ^TMP($J,"RA DISCLAIMER",5,5)=" detailed dose information is available on the modality (until it is deleted)" "RTN","RADRPT2A",232,0) S ^TMP($J,"RA DISCLAIMER",5,6)=" or in the DICOM Radiation Dose Structured Report (RDSR) file stored in VistA" "RTN","RADRPT2A",233,0) S ^TMP($J,"RA DISCLAIMER",5,7)=" Imaging. Viewing the RDSR file is not yet supported." "RTN","RADRPT2A",234,0) Q "RTN","RADRPT2A",235,0) ; "RTN","RADUTL") 0^1^B42704172^B31087705 "RTN","RADUTL",1,0) RADUTL ;HISC/GJC Radiation dosage data filing utility ;12 Jul 2017 9:37 AM "RTN","RADUTL",2,0) ;;5.0;Radiology/Nuclear Medicine;**113,119**;Mar 16, 1998;Build 7 "RTN","RADUTL",3,0) ; "RTN","RADUTL",4,0) ;<<< Business rules >>> "RTN","RADUTL",5,0) ;-Exam moved to a status of 'Complete': Initially create the record in "RTN","RADUTL",6,0) ; 70.3. Call the VI API and get dose parameters. Store the relevant "RTN","RADUTL",7,0) ; radiation dose data in file 70.3. "RTN","RADUTL",8,0) ; "RTN","RADUTL",9,0) ;-Exam backed down from a status of 'Complete': Do nothing; leave rad "RTN","RADUTL",10,0) ; dose data tied to the study "RTN","RADUTL",11,0) ; "RTN","RADUTL",12,0) ;-Exam moved to a status of 'Complete' for a second/nth time: Delete "RTN","RADUTL",13,0) ; existing rad dosage data. Call the VI API and get up to date rad "RTN","RADUTL",14,0) ; dose parameters. Store the relevant rad dose data in file 70.3. "RTN","RADUTL",15,0) ; "RTN","RADUTL",16,0) ;-Exam deleted: The exam is deleted from the database (file 70). "RTN","RADUTL",17,0) ; The rad dosage data tied to the study, a study which no longer "RTN","RADUTL",18,0) ; exists, cannot be referenced via an exam. Therefore, the rad dose "RTN","RADUTL",19,0) ; data record in file 70.3 tied to that study is also deleted. "RTN","RADUTL",20,0) ;<<< end business rules >>> "RTN","RADUTL",21,0) ; "RTN","RADUTL",22,0) ;--- IAs --- "RTN","RADUTL",23,0) ;Call Number Type "RTN","RADUTL",24,0) ;------------------------------------------------ "RTN","RADUTL",25,0) ;FILE^DIE 2056 S "RTN","RADUTL",26,0) ;UPDATE^DIE 2056 S "RTN","RADUTL",27,0) ;REFRESH^MAGVRD03 6000 P "RTN","RADUTL",28,0) ;where 'S'=Supported; 'C'=Controlled Subscription; 'P'=Private "RTN","RADUTL",29,0) ; "RTN","RADUTL",30,0) Q "RTN","RADUTL",31,0) ; "RTN","RADUTL",32,0) DEL(Y) ;delete the top level record from file 70.3 "RTN","RADUTL",33,0) ;called from option: RA DELETEXAM -Exam Deletion "RTN","RADUTL",34,0) ;Input: Y - the top level IEN from file 70.3 "RTN","RADUTL",35,0) N DIERR,RAFDA,RAIEN "RTN","RADUTL",36,0) S RAIEN=Y_",",RAFDA(70.3,RAIEN,.01)="@" D UPDATE^DIE("","RAFDA") "RTN","RADUTL",37,0) Q "RTN","RADUTL",38,0) ; "RTN","RADUTL",39,0) UPCT(RAX,RAII,RAIEN) ;update the CT sub-file 70.31 "RTN","RADUTL",40,0) ;input: RAX array - RAX(IIUID,fld #)=data for that field "RTN","RADUTL",41,0) ; RAII - irradiation instance UID value "RTN","RADUTL",42,0) ; RAIENS - IEN top level record # for 70.3 "RTN","RADUTL",43,0) ;*** First find the IIUID record, if not found add it as new *** "RTN","RADUTL",44,0) N RAFDA,RAH,RAIENS,RAXX,RAY S RAXX="?+1,"_RAIEN_"," "RTN","RADUTL",45,0) S RAFDA(70.31,RAXX,.01)=RAII "RTN","RADUTL",46,0) D UPDATE^DIE("E","RAFDA","RAY(1)") "RTN","RADUTL",47,0) Q:$D(DIERR)#2 "RTN","RADUTL",48,0) S RAH=$G(RAY(1,1)) "RTN","RADUTL",49,0) Q:'RAH S RAIENS=RAH_","_RAIEN_"," "RTN","RADUTL",50,0) ; "RTN","RADUTL",51,0) ;*** file the remaining (non .01 field) CT data *** "RTN","RADUTL",52,0) S RAH=.01 K RAFDA "RTN","RADUTL",53,0) F S RAH=$O(RAX(RAII,RAH)) Q:RAH'>0 D "RTN","RADUTL",54,0) .S RAFDA(70.31,RAIENS,RAH)=$G(RAX(RAII,RAH)) "RTN","RADUTL",55,0) .Q "RTN","RADUTL",56,0) D FILE^DIE("E","RAFDA") "RTN","RADUTL",57,0) Q "RTN","RADUTL",58,0) ; "RTN","RADUTL",59,0) EDTFL(RAP,RAQ,RAR,RAS,RAIENS) ;edit fluoroscopy specific data "RTN","RADUTL",60,0) ;<< assumed RADFN, RADTE & RACN are defined globally >> "RTN","RADUTL",61,0) ;Input: RAP - DOSE COLLECTED WITHIN THE VA? (#.04) "RTN","RADUTL",62,0) ; RAQ - AIR KERMA (#.05) "RTN","RADUTL",63,0) ; RAR - AIR KERMA AREA PRODUCT (#.06) "RTN","RADUTL",64,0) ; RAS - TOTAL FLUOROSCOPY TIME (#.07) "RTN","RADUTL",65,0) ; RAIENS - IEN file 70.3 "RTN","RADUTL",66,0) ; "RTN","RADUTL",67,0) ;Note: All input variables are REQUIRED. If an input "RTN","RADUTL",68,0) ;value is null the value in the field, if any, will "RTN","RADUTL",69,0) ;be deleted. "RTN","RADUTL",70,0) N DIERR,RAFDA "RTN","RADUTL",71,0) Q:RAIENS="" S RAIENS=RAIENS_"," "RTN","RADUTL",72,0) S RAFDA(70.3,RAIENS,.04)=RAP "RTN","RADUTL",73,0) S RAFDA(70.3,RAIENS,.05)=RAQ "RTN","RADUTL",74,0) S RAFDA(70.3,RAIENS,.06)=RAR "RTN","RADUTL",75,0) S RAFDA(70.3,RAIENS,.07)=RAS "RTN","RADUTL",76,0) D FILE^DIE("","RAFDA") "RTN","RADUTL",77,0) Q "RTN","RADUTL",78,0) ; "RTN","RADUTL",79,0) FIND(RADFN,RADTE,RACN) ;find the record in file 70.3 "RTN","RADUTL",80,0) ;Input: RADFN = DFN of the Radiology patient "RTN","RADUTL",81,0) ; RADTE = the EXAM DATE (FM internal value) "RTN","RADUTL",82,0) ; RACN = case number of the study "RTN","RADUTL",83,0) ; "RTN","RADUTL",84,0) ;Output: the IEN of the 70.3 record or null "RTN","RADUTL",85,0) ; "RTN","RADUTL",86,0) Q $O(^RAD("ARAD",RADTE,RADFN,RACN,0)) "RTN","RADUTL",87,0) ; "RTN","RADUTL",88,0) NEW(RADFN,RADTE,RACN) ;create a radiation absorbtion dose (RAD) record "RTN","RADUTL",89,0) ;(top-level) for this exam "RTN","RADUTL",90,0) ;Input: RADFN - the DFN of the patient "RTN","RADUTL",91,0) ; RADTE - the exam date w/time (FM internal format) "RTN","RADUTL",92,0) ; RACN - the case number on the exam "RTN","RADUTL",93,0) ;Return: if successful the record number is returned else return "RTN","RADUTL",94,0) ;an error message. "RTN","RADUTL",95,0) N DIERR,RAFDA,RAIEN703 "RTN","RADUTL",96,0) S RAFDA(70.3,"+1,",.01)=RADFN "RTN","RADUTL",97,0) S RAFDA(70.3,"+1,",.02)=RADTE,RAFDA(70.3,"+1,",.03)=RACN "RTN","RADUTL",98,0) D UPDATE^DIE("","RAFDA","RAIEN703") "RTN","RADUTL",99,0) S RAIEN703=$S(+$G(RAIEN703(1))>0:RAIEN703(1),1:"-1^unable to create a radiation dose record for this exam") "RTN","RADUTL",100,0) Q RAIEN703 "RTN","RADUTL",101,0) ; "RTN","RADUTL",102,0) ;---------------------------------------------------------------- "RTN","RADUTL",103,0) ; "RTN","RADUTL",104,0) RADPTR(RADFN,RADTI,RACNI,Y) ;file/delete the pointer value from 70.3 from "RTN","RADUTL",105,0) ;the RADIATION ABSORBED DOSAGE (1.1) field of the EXAMINATION (70.03) "RTN","RADUTL",106,0) ;sub-file. "RTN","RADUTL",107,0) ;Input: RADFN - the DFN of the patient DA(2) "RTN","RADUTL",108,0) ; RADTI - inverse exam date/time DA(1) "RTN","RADUTL",109,0) ; RACNI - the exam record number DA "RTN","RADUTL",110,0) ; Y - if filing the file 70.3 record number "RTN","RADUTL",111,0) ; if deleting the "@" "RTN","RADUTL",112,0) ; "RTN","RADUTL",113,0) N DIERR,RAFDA,RAIENS S RAIENS=RACNI_","_RADTI_","_RADFN_"," "RTN","RADUTL",114,0) S RAFDA(70.03,RAIENS,1.1)=Y D FILE^DIE("","RAFDA") "RTN","RADUTL",115,0) Q "RTN","RADUTL",116,0) ; "RTN","RADUTL",117,0) II(X) ;check the data integrity of the Irradiation Instance UID (IIUID). "RTN","RADUTL",118,0) ;Definition: IIUID is defined as a character string containing a UID "RTN","RADUTL",119,0) ;that is used to uniquely identify a wide variety of items. The UID "RTN","RADUTL",120,0) ;is a series of numeric components separated by the period "." "RTN","RADUTL",121,0) ;character. If a Value Field containing one or more UIDs is an "RTN","RADUTL",122,0) ;odd number of bytes in length, the Value Field shall be padded "RTN","RADUTL",123,0) ;with a single trailing NULL (00H) character (binary: 00000000) "RTN","RADUTL",124,0) ;to ensure that the Value Field is an even number of bytes in length. "RTN","RADUTL",125,0) ; "RTN","RADUTL",126,0) ;Data format: "0"-"9", "." (A series of numeric components separated "RTN","RADUTL",127,0) ;by the period "." character) "RTN","RADUTL",128,0) ; "RTN","RADUTL",129,0) ;Length: 64 bytes maximum "RTN","RADUTL",130,0) ; "RTN","RADUTL",131,0) ;Input: X = the IIUID with padding or w/o padding "RTN","RADUTL",132,0) ;Return: the IIUID w/o padding "RTN","RADUTL",133,0) ; "RTN","RADUTL",134,0) Q $P(X,$C(0),1) "RTN","RADUTL",135,0) ; "RTN","RADUTL",136,0) GETDOSE ;call the Imaging API which returns radiation dose data for a study "RTN","RADUTL",137,0) ; RADFN, RADTI & RACNI exist "RTN","RADUTL",138,0) ; RAY2, RAY3 & RAIT set in RAORDC "RTN","RADUTL",139,0) ; $P(RAY3,U) = case # "RTN","RADUTL",140,0) N D,FLD,I,II,P,Q,RACCNUM,RADOSE,RAIEN,RAII,RAQ,RARY,X "RTN","RADUTL",141,0) ;S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)) "RTN","RADUTL",142,0) ;S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) "RTN","RADUTL",143,0) S RACCNUM=$P(RAY3,U,31) ;SSAN "RTN","RADUTL",144,0) S:RACCNUM="" RACCNUM=$E(RAY2,4,7)_$E(RAY2,2,3)_"-"_$P(RAY3,U) "RTN","RADUTL",145,0) ;S X=$P($G(^RA(79.2,$P(RAY2,U,2),0)),U,3) ;abbreviation "RTN","RADUTL",146,0) ;S RAIT=$S(X="RAD":"FLUORO",1:"CT") "RTN","RADUTL",147,0) ; "RTN","RADUTL",148,0) D REFRESH^MAGVRD03(.RARY,RADFN,RACCNUM,RAIT) "RTN","RADUTL",149,0) Q:+RARY(1)'=0 ;'0' indicates the call was a success; else quit "RTN","RADUTL",150,0) Q:$P(RARY(1),"`",3)=0 ;call a success but no data "RTN","RADUTL",151,0) ; "RTN","RADUTL",152,0) ;set RADTE if it is not defined "RTN","RADUTL",153,0) S:'$D(RADTE)#2 RADTE=9999999.9999-RADTI ;P119 h/t Fayetteville, NC "RTN","RADUTL",154,0) ;is there an existing rad dose record for this study? "RTN","RADUTL",155,0) S RADOSE=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,1)),U) "RTN","RADUTL",156,0) ;if RADOSE="" create new record in file 70.3 "RTN","RADUTL",157,0) S:RADOSE="" RADOSE=$$NEW(RADFN,RADTE,$P(RAY3,U)) "RTN","RADUTL",158,0) ; "RTN","RADUTL",159,0) ;<<< FORMAT the data into a structure I can use. Note: the variable 'D' will act as my delimiter >>> "RTN","RADUTL",160,0) S D="|" "RTN","RADUTL",161,0) ; "RTN","RADUTL",162,0) ; Note: Each new CT repetition starts with TYPE "RTN","RADUTL",163,0) ; as a label "RTN","RADUTL",164,0) ; "RTN","RADUTL",165,0) ;CT from: ARRAY(n)=field name_D_value "RTN","RADUTL",166,0) ; to: RAQ(IIUID,field 70.31)=value "RTN","RADUTL",167,0) ;IRRADIATION INSTANCE -> fld: .01; TARGET REGION -> fld: 2 "RTN","RADUTL",168,0) ;PHANTOM TYPE -> fld: 3; CTDIvol -> fld: 4 and DLP -> fld: 5 "RTN","RADUTL",169,0) I RAIT="CT" D "RTN","RADUTL",170,0) .K RAQ S RAI=$O(RARY(0)) ;# rec indicator "RTN","RADUTL",171,0) .S RAI=0 F S RAI=$O(RARY(RAI)) Q:RAI'>0 D "RTN","RADUTL",172,0) ..S X=$G(RARY(RAI)) "RTN","RADUTL",173,0) ..I $P(X,D,1)="IRRADIATION INSTANCE UID" D "RTN","RADUTL",174,0) ...S II=$$II($P(X,D,2)) ;IIUID "RTN","RADUTL",175,0) ...S RAQ(II,.01)=II "RTN","RADUTL",176,0) ...Q "RTN","RADUTL",177,0) ..;I $P(X,D,1)="TARGET REGION" S RAQ(II,2)=$P(X,D,2) ;T6 don't file TR "RTN","RADUTL",178,0) ..I $P(X,D,1)="PHANTOM TYPE" S RAQ(II,3)=$P(X,D,2) "RTN","RADUTL",179,0) ..I $P(X,D,1)="CTDIVOL" S RAQ(II,4)=$S($P(X,D,2)>0:+$P(X,D,2),1:"") ;p119 "RTN","RADUTL",180,0) ..I $P(X,D,1)="DLP" S RAQ(II,5)=$S($P(X,D,2)>0:+$P(X,D,2),1:"") ;p119 "RTN","RADUTL",181,0) ..; $S added for fields 4 & 5 above to record a null value as an empty field "RTN","RADUTL",182,0) ..; +$P(X,D,2) used to turn 5.100000000 to 5.1 "RTN","RADUTL",183,0) ..; reports will display values to their proper fractional part precision "RTN","RADUTL",184,0) ..Q "RTN","RADUTL",185,0) .K RARY S RAII="" "RTN","RADUTL",186,0) .F S RAII=$O(RAQ(RAII)) Q:RAII="" D "RTN","RADUTL",187,0) ..D UPCT(.RAQ,RAII,RADOSE) ;update CT multiple "RTN","RADUTL",188,0) ..Q "RTN","RADUTL",189,0) .K I,II,RAI,RAII,RAQ,X "RTN","RADUTL",190,0) .Q "RTN","RADUTL",191,0) ; "RTN","RADUTL",192,0) ; "RTN","RADUTL",193,0) ;FLUORO from: ARRAY(n)=field name_D_value "RTN","RADUTL",194,0) ; to: RAQ(field 70.3)=value "RTN","RADUTL",195,0) E D ;else if RAIT="FLUORO" "RTN","RADUTL",196,0) .;TOTAL TIME IN FLUOROSCOPY (2005.633,2) maps to "RTN","RADUTL",197,0) .; TOTAL FLUOROSCOPY TIME (70.3,.07) "RTN","RADUTL",198,0) .; "RTN","RADUTL",199,0) .;CINE DOSE (RP) TOTAL (2005.633,12) + FLUORO DOSE (RP) TOTAL (2005.633,10) "RTN","RADUTL",200,0) .; maps to the RIS' AIR KERMA (70.3,.05) field "RTN","RADUTL",201,0) .; "RTN","RADUTL",202,0) .;FLUORO DOSE AREA PRODUCT TOTAL (2005.633,11) + "RTN","RADUTL",203,0) .; CINE DOSE AREA PRODUCT TOTAL (2005.633,13) "RTN","RADUTL",204,0) .; maps to AIR KERMA AREA PRODUCT (70.3,.06) "RTN","RADUTL",205,0) .; "RTN","RADUTL",206,0) .S T="0^0^0" "RTN","RADUTL",207,0) .;first piece RIS' AIR KERMA (70.3,.05) "RTN","RADUTL",208,0) .;second piece RIS' AIR KERMA AREA PRODUCT (70.3,.06) "RTN","RADUTL",209,0) .;third piece RIS' TOTAL FLUOROSCOPY TIME (70.3,.07) "RTN","RADUTL",210,0) .; "RTN","RADUTL",211,0) .S RAI=$O(RARY(0)) ;# rec indicator "RTN","RADUTL",212,0) .F S RAI=$O(RARY(RAI)) Q:RAI'>0 D "RTN","RADUTL",213,0) ..S X=$G(RARY(RAI)) "RTN","RADUTL",214,0) ..S:$P(X,D,1)="CINE DOSE (RP) TOTAL" $P(T,U,1)=$P(T,U,1)+(+$FN($P(X,D,2),"",9)) ;p119T6 "RTN","RADUTL",215,0) ..S:$P(X,D,1)="FLUORO DOSE (RP) TOTAL" $P(T,U,1)=$P(T,U,1)+(+$FN($P(X,D,2),"",9)) ;p119T6 "RTN","RADUTL",216,0) ..; "RTN","RADUTL",217,0) ..S:$P(X,D,1)="FLUORO DOSE AREA PRODUCT TOTAL" $P(T,U,2)=$P(T,U,2)+(+$FN($P(X,D,2),"",9)) ;p119T6 "RTN","RADUTL",218,0) ..S:$P(X,D,1)="CINE DOSE AREA PRODUCT TOTAL" $P(T,U,2)=$P(T,U,2)+(+$FN($P(X,D,2),"",9)) ;p119T6 "RTN","RADUTL",219,0) ..; "RTN","RADUTL",220,0) ..S:$P(X,D,1)="TOTAL TIME IN FLUOROSCOPY" $P(T,U,3)=$P(T,U,3)+$P(X,D,2) "RTN","RADUTL",221,0) ..Q "RTN","RADUTL",222,0) .;file fluoro data into file 70.3 "RTN","RADUTL",223,0) .K RARY D EDTFL("",$P(T,U,1),$P(T,U,2),$P(T,U,3),RADOSE) "RTN","RADUTL",224,0) .K RAI,T,X "RTN","RADUTL",225,0) .Q "RTN","RADUTL",226,0) ; "RTN","RADUTL",227,0) ; "RTN","RADUTL",228,0) ;<<< update the EXAMINATIONS sub-file's >>> "RTN","RADUTL",229,0) ; RADIATION ABSORBED DOSE field (#1.1) "RTN","RADUTL",230,0) D RADPTR(RADFN,RADTI,RACNI,RADOSE) "RTN","RADUTL",231,0) Q "RTN","RADUTL",232,0) ; "RTN","RAIPS119") 0^4^B473200^n/a "RTN","RAIPS119",1,0) RAIPS119 ;HIOFO/GJC - Post-init one of one ; "RTN","RAIPS119",2,0) VERSION ;;5.0;Radiology/Nuclear Medicine;**119**;Mar 16, 1998;Build 7 "RTN","RAIPS119",3,0) ; "RTN","RAIPS119",4,0) ;IA - #6203 w/VA FileMan to delete the "RDE" xref & data "RTN","RAIPS119",5,0) ; "RTN","RAIPS119",6,0) EN ;entry point "RTN","RAIPS119",7,0) D RDE "RTN","RAIPS119",8,0) Q "RTN","RAIPS119",9,0) ; "RTN","RAIPS119",10,0) RDE ; delete the MUMPS "RDE" cross reference on the RADIATION ABSORBED "RTN","RAIPS119",11,0) ;DOSE field (70.03 ; node one ;field #: 1.1). Delete all cross "RTN","RAIPS119",12,0) ;referenced data in "RDE". "RTN","RAIPS119",13,0) ; "RTN","RAIPS119",14,0) ;parameters: "RTN","RAIPS119",15,0) ; 70 - the file number with the "RDE" index (file-wide) "RTN","RAIPS119",16,0) ; "RDE" - the name of the index to be deleted "RTN","RAIPS119",17,0) ; "RTN","RAIPS119",18,0) N DIERR K ^TMP("DIERR",$J) "RTN","RAIPS119",19,0) D DELIXN^DDMOD(70,"RDE") ; "RTN","RAIPS119",20,0) K ^RADPT("RDE") ; Whole Kill "RTN","RAIPS119",21,0) I $D(DIERR)#2 D "RTN","RAIPS119",22,0) .S RATXT=$G(^TMP("DIERR",$J,1,"TEXT",1)) "RTN","RAIPS119",23,0) .D:$L(RATXT) MES^XPDUTL(RATXT) "RTN","RAIPS119",24,0) .K RATXT "RTN","RAIPS119",25,0) .Q "RTN","RAIPS119",26,0) K ^TMP("DIERR",$J) "RTN","RAIPS119",27,0) Q "RTN","RAIPS119",28,0) ; "UP",70,70.03,-2) 70^DT "UP",70,70.03,-1) 70.02^P "UP",70,70.03,0) 70.03 "VER") 8.0^22.2 "^DD",70,70.03,1.1,0) RADIATION ABSORBED DOSE^P70.3'^RAD(^1;1^Q "^DD",70,70.03,1.1,1,0) ^.1^^0 "^DD",70,70.03,1.1,3) Enter the patient whose radiation absorbed dosage record is a result of this study. "^DD",70,70.03,1.1,21,0) ^^4^4^3130416^ "^DD",70,70.03,1.1,21,1,0) This field references the radiation absorbed record associated with this "^DD",70,70.03,1.1,21,2,0) study. Please refer to the Radiology/Nuclear Medicine User Manual for "^DD",70,70.03,1.1,21,3,0) information concerning the modalities involved in the radiation absorbed "^DD",70,70.03,1.1,21,4,0) dose collection. "^DD",70,70.03,1.1,"DT") 3150514 "^DD",70.3,70.3,0) FIELD^^100^8 "^DD",70.3,70.3,0,"DDA") N "^DD",70.3,70.3,0,"DT") 3150507 "^DD",70.3,70.3,0,"ID",.02) W " ",$$FMTE^DILIBF($P(^(0),U,2),6) "^DD",70.3,70.3,0,"ID",.03) W " ",$P(^(0),U,3) "^DD",70.3,70.3,0,"IX","B",70.3,.01) "^DD",70.3,70.3,0,"NM","RADIATION ABSORBED DOSE") "^DD",70.3,70.3,0,"PT",70.03,1.1) "^DD",70.3,70.3,.01,0) PATIENT^RP2'^DPT(^0;1^Q "^DD",70.3,70.3,.01,1,0) ^.1 "^DD",70.3,70.3,.01,1,1,0) 70.3^B "^DD",70.3,70.3,.01,1,1,1) S ^RAD("B",$E(X,1,30),DA)="" "^DD",70.3,70.3,.01,1,1,2) K ^RAD("B",$E(X,1,30),DA) "^DD",70.3,70.3,.01,3) Enter the patient absorbing radiation associated with this exam. "^DD",70.3,70.3,.01,21,0) ^^2^2^3120910^ "^DD",70.3,70.3,.01,21,1,0) This field identifies the patient absorbing radiation associated with this "^DD",70.3,70.3,.01,21,2,0) exam. "^DD",70.3,70.3,.01,"DT") 3130130 "^DD",70.3,70.3,.02,0) EXAM DATE/TIME^RDI^^0;2^S %DT="ETXR" D ^%DT S X=Y K:Y<1 X "^DD",70.3,70.3,.02,3) Enter the exam date/time of the exam. "^DD",70.3,70.3,.02,21,0) ^.001^1^1^3120911^^^ "^DD",70.3,70.3,.02,21,1,0) This field identifies the exam date/time of the exam. "^DD",70.3,70.3,.02,23,0) ^.001^17^17^3120911^^ "^DD",70.3,70.3,.02,23,1,0) "^DD",70.3,70.3,.02,23,2,0) "^DD",70.3,70.3,.02,23,3,0) VA Classic FileMan "^DD",70.3,70.3,.02,23,4,0) ------------------ "^DD",70.3,70.3,.02,23,5,0) With Classic FileMan (^DIE) a required field cannot be deleted. "^DD",70.3,70.3,.02,23,6,0) "^DD",70.3,70.3,.02,23,7,0) "^DD",70.3,70.3,.02,23,8,0) VA FileMan Database Server "^DD",70.3,70.3,.02,23,9,0) -------------------------- "^DD",70.3,70.3,.02,23,10,0) With the Database Server (DBS) FileMan utilities (FILE^DIE) when the 'E' "^DD",70.3,70.3,.02,23,11,0) (external) flag is used, a process cannot delete the field value if the "^DD",70.3,70.3,.02,23,12,0) field is either required or uneditable. "^DD",70.3,70.3,.02,23,13,0) "^DD",70.3,70.3,.02,23,14,0) Without the 'E' flag, deletion will occur if required or uneditable. "^DD",70.3,70.3,.02,23,15,0) "^DD",70.3,70.3,.02,23,16,0) When key integrity is checked (the U flag is not used), a process cannot "^DD",70.3,70.3,.02,23,17,0) delete the value of a key field whether the E flag is used or not. "^DD",70.3,70.3,.02,"DT") 3130130 "^DD",70.3,70.3,.03,0) CASE NUMBER^RNJ5,0I^^0;3^K:+X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N) X "^DD",70.3,70.3,.03,3) Enter the case number of the exam. Case number must be a number from 1 to 99999, zero decimal digits. "^DD",70.3,70.3,.03,21,0) ^.001^1^1^3120910^^ "^DD",70.3,70.3,.03,21,1,0) This field tracks the case number of the exam. "^DD",70.3,70.3,.03,23,0) ^^17^17^3120910^ "^DD",70.3,70.3,.03,23,1,0) "^DD",70.3,70.3,.03,23,2,0) "^DD",70.3,70.3,.03,23,3,0) VA Classic FileMan "^DD",70.3,70.3,.03,23,4,0) ------------------ "^DD",70.3,70.3,.03,23,5,0) With Classic FileMan (^DIE) a required field cannot be deleted. "^DD",70.3,70.3,.03,23,6,0) "^DD",70.3,70.3,.03,23,7,0) "^DD",70.3,70.3,.03,23,8,0) VA FileMan Database Server "^DD",70.3,70.3,.03,23,9,0) -------------------------- "^DD",70.3,70.3,.03,23,10,0) With the Database Server (DBS) FileMan utilities (FILE^DIE) when the 'E' "^DD",70.3,70.3,.03,23,11,0) (external) flag is used, a process cannot delete the field value if the "^DD",70.3,70.3,.03,23,12,0) field is either required or uneditable. "^DD",70.3,70.3,.03,23,13,0) "^DD",70.3,70.3,.03,23,14,0) Without the 'E' flag, deletion will occur if required or uneditable. "^DD",70.3,70.3,.03,23,15,0) "^DD",70.3,70.3,.03,23,16,0) When key integrity is checked (the U flag is not used), a process cannot "^DD",70.3,70.3,.03,23,17,0) delete the value of a key field whether the E flag is used or not. "^DD",70.3,70.3,.03,"DT") 3130130 "^DD",70.3,70.3,.04,0) DOSE COLLECTED WITHIN THE VA?^S^1:Yes;0:No;^0;4^Q "^DD",70.3,70.3,.04,3) Was the exam introducing the radiation performed under the direction of the Department of Veterans Affairs (VA)? "^DD",70.3,70.3,.04,21,0) ^.001^2^2^3130205^^ "^DD",70.3,70.3,.04,21,1,0) This field tracks whether the exam introducing the radiation was performed "^DD",70.3,70.3,.04,21,2,0) under the direction of the Department of Veterans Affairs (VA). "^DD",70.3,70.3,.04,"DT") 3130416 "^DD",70.3,70.3,.05,0) AIR KERMA^NJ16,9^^0;5^K:+X'=X!(X>999999)!(X<0)!(X?.E1"."10N.N) X "^DD",70.3,70.3,.05,3) Type a number between 0 and 999999, 9 decimal digits. "^DD",70.3,70.3,.05,21,0) ^.001^6^6^3150507^^^^ "^DD",70.3,70.3,.05,21,1,0) Kinetic energy released in matter (Kerma), is defined as the sum of the "^DD",70.3,70.3,.05,21,2,0) initial energies of all the charged particles liberated by uncharged "^DD",70.3,70.3,.05,21,3,0) ionizing radiation in a material of given mass per unit mass. Kerma in "^DD",70.3,70.3,.05,21,4,0) air is called 'air kerma'. "^DD",70.3,70.3,.05,21,5,0) "^DD",70.3,70.3,.05,21,6,0) Unit: Milligray (mGy) "^DD",70.3,70.3,.05,"DT") 3150507 "^DD",70.3,70.3,.06,0) AIR KERMA AREA PRODUCT^NJ15,9^^0;6^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."10N.N) X "^DD",70.3,70.3,.06,3) Type a number between 0 and 99999, 9 decimal digits. "^DD",70.3,70.3,.06,21,0) ^.001^6^6^3150507^^ "^DD",70.3,70.3,.06,21,1,0) Air Kerma Area Product is defined as the air kerma at a particular "^DD",70.3,70.3,.06,21,2,0) location in an x-ray beam multiplied by the cross-sectional area of the "^DD",70.3,70.3,.06,21,3,0) beam at that location. It is an approximate indication of the total amount "^DD",70.3,70.3,.06,21,4,0) of energy delivered by the x-ray beam. "^DD",70.3,70.3,.06,21,5,0) "^DD",70.3,70.3,.06,21,6,0) Unit: Gray centimeters squared (Gy-cm2) "^DD",70.3,70.3,.06,"DT") 3150507 "^DD",70.3,70.3,.07,0) TOTAL FLUOROSCOPY TIME^NJ8,2^^0;7^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."3N.N) X "^DD",70.3,70.3,.07,3) Enter the total amount of time the patient was exposed to fluoroscopy sourced radiation. This value must be a number from 0 to 99999, 2 decimal digits. "^DD",70.3,70.3,.07,21,0) ^^8^8^3130205^ "^DD",70.3,70.3,.07,21,1,0) The ability of fluoroscopy to display motion is provided by a continuous "^DD",70.3,70.3,.07,21,2,0) series of images produced per second. High radiation exposures to patients "^DD",70.3,70.3,.07,21,3,0) can result from multiple series of images. "^DD",70.3,70.3,.07,21,4,0) "^DD",70.3,70.3,.07,21,5,0) Therefore, total fluoroscopic time is one of the metrics that determines "^DD",70.3,70.3,.07,21,6,0) the exposure to the patient from fluoroscopy. "^DD",70.3,70.3,.07,21,7,0) "^DD",70.3,70.3,.07,21,8,0) Unit: seconds (time) "^DD",70.3,70.3,.07,"DT") 3130205 "^DD",70.3,70.3,100,0) IRRADIATION INSTANCE UID^70.31A^^II;0 "^DD",70.3,70.3,100,21,0) ^^6^6^3130416^ "^DD",70.3,70.3,100,21,1,0) An irradiation event is the occurrence of radiation being applied to a "^DD",70.3,70.3,100,21,2,0) patient in a single continuous time-frame between the start (release) and "^DD",70.3,70.3,100,21,3,0) the stop (cease) of the irradiation. "^DD",70.3,70.3,100,21,4,0) "^DD",70.3,70.3,100,21,5,0) This sub-file is a record of up to five of the highest irradiation "^DD",70.3,70.3,100,21,6,0) instances for this study. "^DD",70.3,70.31,0) IRRADIATION INSTANCE UID SUB-FIELD^^5^5 "^DD",70.3,70.31,0,"DT") 3150310 "^DD",70.3,70.31,0,"IX","B",70.31,.01) "^DD",70.3,70.31,0,"NM","IRRADIATION INSTANCE UID") "^DD",70.3,70.31,0,"UP") 70.3 "^DD",70.3,70.31,.01,0) IRRADIATION INSTANCE UID^MRF^^0;1^K:$L(X)>64!($L(X)<3)!'(X?1.N1".".PN) X "^DD",70.3,70.31,.01,1,0) ^.1 "^DD",70.3,70.31,.01,1,1,0) 70.31^B "^DD",70.3,70.31,.01,1,1,1) S ^RAD(DA(1),"II","B",$E(X,1,64),DA)="" "^DD",70.3,70.31,.01,1,1,2) K ^RAD(DA(1),"II","B",$E(X,1,64),DA) "^DD",70.3,70.31,.01,3) The Irradiation Instance UID must be 3-64 characters in length. "^DD",70.3,70.31,.01,21,0) ^.001^3^3^3130530^^^^ "^DD",70.3,70.31,.01,21,1,0) An irradiation event is the occurrence of radiation being applied to a "^DD",70.3,70.31,.01,21,2,0) patient in a single continuous time-frame between the start (release) and "^DD",70.3,70.31,.01,21,3,0) the stop (cease) of the irradiation. "^DD",70.3,70.31,.01,23,0) ^.001^11^11^3130530^^^^ "^DD",70.3,70.31,.01,23,1,0) The Irradiation Instance UID is defined as a character string containing a "^DD",70.3,70.31,.01,23,2,0) UID that is used to uniquely identify a wide variety of items. The UID is "^DD",70.3,70.31,.01,23,3,0) a series of numeric components separated by the period "." character. If a "^DD",70.3,70.31,.01,23,4,0) Value Field containing one or more UIDs is an odd number of bytes in "^DD",70.3,70.31,.01,23,5,0) length, the Value Field shall be padded with a single trailing NULL (00H) "^DD",70.3,70.31,.01,23,6,0) character to ensure that the Value Field is an even number of bytes in "^DD",70.3,70.31,.01,23,7,0) length. "^DD",70.3,70.31,.01,23,8,0) "^DD",70.3,70.31,.01,23,9,0) DICOM Value Representation: UI (Unique Identifier) "^DD",70.3,70.31,.01,23,10,0) Data format: "0"-"9", "." (A series of numeric components separated by "^DD",70.3,70.31,.01,23,11,0) the period "." character) "^DD",70.3,70.31,.01,"DT") 3130530 "^DD",70.3,70.31,2,0) ANATOMICAL TARGET REGION^P2005.6361'^MAGV(2005.6361,^0;2^Q "^DD",70.3,70.31,2,3) Enter the part of the body scanned. "^DD",70.3,70.31,2,21,0) ^.001^6^6^3130411^^ "^DD",70.3,70.31,2,21,1,0) This is the part of the body scanned through the emitting of a series of "^DD",70.3,70.31,2,21,2,0) x-ray beams. "^DD",70.3,70.31,2,21,3,0) "^DD",70.3,70.31,2,21,4,0) For example, you might need a CT scan of the brain, liver, kidneys, or "^DD",70.3,70.31,2,21,5,0) lungs. The target areas of CT scans are usually sinuses, the head, chest, "^DD",70.3,70.31,2,21,6,0) abdomen, and pelvic regions. "^DD",70.3,70.31,2,"DT") 3130411 "^DD",70.3,70.31,3,0) PHANTOM TYPE^P2005.6362'^MAGV(2005.6362,^0;3^Q "^DD",70.3,70.31,3,3) Enter the appropriate phantom used in this instance. "^DD",70.3,70.31,3,21,0) ^.001^2^2^3130411^^ "^DD",70.3,70.31,3,21,1,0) A model of the human body or any of its parts used for predicting "^DD",70.3,70.31,3,21,2,0) irradiation dosage within the body. "^DD",70.3,70.31,3,"DT") 3130411 "^DD",70.3,70.31,4,0) CTDIvol^NJ15,9^^0;4^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."10N.N) X "^DD",70.3,70.31,4,.1) "^DD",70.3,70.31,4,3) Type a number between 0 and 99999, 9 decimal digits. "^DD",70.3,70.31,4,21,0) ^.001^9^9^3150310^^^ "^DD",70.3,70.31,4,21,1,0) The Computed Tomography Dose Index volume (CTDIvol) is approximately the "^DD",70.3,70.31,4,21,2,0) average dose that would have been delivered to a standard cylindrical "^DD",70.3,70.31,4,21,3,0) plastic phantom for a specific examination. One phantom is used for head "^DD",70.3,70.31,4,21,4,0) scans and another larger diameter phantom is used for body scans. The "^DD",70.3,70.31,4,21,5,0) CTDIvol must be adjusted for body size and other factors to estimate the "^DD",70.3,70.31,4,21,6,0) dose to the scanned volume of a actual patient. However, the CTDIvol is "^DD",70.3,70.31,4,21,7,0) very useful for comparing and adjusting CT imaging protocols. "^DD",70.3,70.31,4,21,8,0) "^DD",70.3,70.31,4,21,9,0) Unit: mGy (milligray) "^DD",70.3,70.31,4,"DT") 3150310 "^DD",70.3,70.31,5,0) DLP^NJ15,9^^0;5^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."10N.N) X "^DD",70.3,70.31,5,.1) "^DD",70.3,70.31,5,3) Type a number between 0 and 99999, 9 decimal digits. "^DD",70.3,70.31,5,21,0) ^.001^4^4^3150310^^^^ "^DD",70.3,70.31,5,21,1,0) The Dose Length Product (DLP) is the CTDIvol multiplied by the scan "^DD",70.3,70.31,5,21,2,0) length (slice thickness * number of slices) in centimeters. "^DD",70.3,70.31,5,21,3,0) "^DD",70.3,70.31,5,21,4,0) Unit: mGy-cm (milligray-centimeters) "^DD",70.3,70.31,5,"DT") 3150310 "^DIC",70.3,70.3,0) RADIATION ABSORBED DOSE^70.3 "^DIC",70.3,70.3,0,"GL") ^RAD( "^DIC",70.3,70.3,"%",0) ^1.005^^ "^DIC",70.3,70.3,"%D",0) ^1.001^4^4^3130808^^ "^DIC",70.3,70.3,"%D",1,0) This file is used to measure the amount of radiation absorbed by a person, "^DIC",70.3,70.3,"%D",2,0) known as the "absorbed dose," which reflects the amount of energy that "^DIC",70.3,70.3,"%D",3,0) radioactive sources deposit in patients, on a study by study basis, "^DIC",70.3,70.3,"%D",4,0) through which they pass. "^DIC",70.3,"B","RADIATION ABSORBED DOSE",70.3) "BLD",9041,6) ^122 **END** **END**