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

RAO7PC1.m

Go to the documentation of this file.
  1. RAO7PC1 ;HISC/GJC,SS-Procedure Call utilities. ; Jan 12, 2021@08:36:20
  1. ;;5.0;Radiology/Nuclear Medicine;**1,16,18,26,36,45,75,143,156,166,178**;Mar 16, 1998;Build 2
  1. ;
  1. EN1(RADFN,RABDT,RAEDT,RAEXN,RACINC) ;
  1. ;
  1. ; DBIA#2043 - Return list of exams within date range
  1. ;
  1. ; ** See routines RAO7PC1A and RAO7PC2 for additional comments **
  1. ; ** and output node descriptions **
  1. ;
  1. ; Input: RADFN-> Patient IEN RABDT-> beginning date
  1. ; RAEDT-> ending date RAEXN-> max # of exams
  1. ; RACINC-> include cancelled exams? (1 if yes, default no)
  1. ;
  1. ; Output:
  1. ; ^TMP($J,"RAE1",Patient IEN,Exam ID)=Procedure name^Case number^
  1. ; Report status^Abnormal alert flag^Report ien^
  1. ; Exam status order #~Exam status name^
  1. ; Imaging location name^Imaging type abbr~
  1. ; Imaging type name^abnormal results flag^CPT Code
  1. ; ^CPRS Order ien^Images exist flag
  1. ;
  1. ;if there are one or more CPT modifiers:
  1. ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",n)=CPT Mod^CPT Mod Name
  1. ; n+1)=CPT Mod^CPT Mod Name
  1. ;
  1. ;if CPRS asks to display parent procs, and case is descendent of parent:
  1. ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CPRS")=memb of set^parent prc name
  1. ;
  1. ; Note: It is possible for the ^TMP global data returned to contain
  1. ; 'No Report' and a Report file ien for the same exam. This is
  1. ; because Imaging can create a report stub in the Report file,
  1. ; but no report interpretation exists and no status is assigned
  1. ; to the report record.
  1. ;
  1. ; Exam ID: exam date/time (inverse) concatenated with the case IEN
  1. ; Abnormal alert flag: Y or blank
  1. ; Abnormal results flag: Y or blank, may be turned on even if
  1. ; abnormal alert flag is not
  1. ;
  1. Q:'RADFN!('RABDT)!('RAEDT)
  1. N RAEXNP S RAEXNP=RAEXN ;save original value of RAEXN
  1. ; if last char RAEXNP has "P", then count max no. by parent and
  1. ; single, not by individual cases
  1. S RACINC=+$G(RACINC)
  1. Q:RABDT>RAEDT ; quit if ending date before beginning date
  1. K ^TMP($J,"RAE1") S RAEXN=+$G(RAEXN)
  1. S:$P(RABDT,".",2) RABDT=RABDT\1 S:$P(RAEDT,".",2) RAEDT=RAEDT\1
  1. N RABNOR,RACNST,RACNT,RACPT,RACSE,RADIAG,RAIBDT,RAIEDT,RAILOC,RAITY
  1. N RANO,RAPRC,RAREX,RARPT,RARPTST
  1. N RAXAM,RAXID,RAXIT,RAXSTAT,RABNORMR,RASHOCAN
  1. S RACNST=9999999.9999
  1. S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001)
  1. S (RACNT,RAXIT)=0
  1. F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D Q:RAXIT
  1. . D SETDATA^RAO7PC1A ; obtain exam data, set ^TMP($J,"RAE1",Patient IEN,Exam ID)
  1. . Q
  1. Q
  1. EN2(RADFN) ;
  1. ;
  1. ; DBIA#2012 - Return last 7 days of non-cancelled exams
  1. ;
  1. ; Input: RADFN-> Patient IEN
  1. ;
  1. ; Output:
  1. ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^
  1. ; report status^imaging location IEN^imaging location name^
  1. ; contrast medium or media used
  1. ; Note: Single characters in parenthesis indicate contrast
  1. ; involvement: (I)=Iodinated ionic; (N)=Iodinated non-ionic;
  1. ; (L)=Gadolinium; (C)=Oral Cholecystographic; (G)=Gastrografin;
  1. ; (B)=Barium; (M)=unspecified contrast media
  1. ;
  1. ; Exam ID: exam date/time (inverse) concatenated with the case IEN
  1. ;
  1. Q:'RADFN D EN2^RAO7PC1A Q
  1. ;
  1. EN3(X) ; DBIA#2265 - Return narrative text for exam(s)
  1. ; Input:
  1. ; X-> Exam id in one of two forms:
  1. ; 1) Pat. DFN^inv. exam date^Case IEN
  1. ; Retrieves a single report for a single exam
  1. ; 2) Pat. DFN^inv. exam date^
  1. ; Retrieves all reports for a set of exams ordered on one order
  1. ;
  1. ; Note: Input delimiter can be any of the following: ^~\&;-
  1. ; a delimiter may be a single space i.e, " "
  1. ;
  1. ; Output:
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name)=report status^
  1. ; abnormal alert flag^CPRS Order ien^amended report?
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"CM",n)=contrast
  1. ; media used during exam (internal)^contrast media used during exam
  1. ; (external)
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"D",n)=diagnostic
  1. ; code (n=1, this is the primary code)
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"H",n)=clin history
  1. ; (a line of text)
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"I",n)=impression
  1. ; (a line of text)
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"M",n)=modifier
  1. ; (external format)
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"P")=primary
  1. ; interpreting staff IEN^primary interpreting resident IEN^date
  1. ; report entered
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"R",n)=report
  1. ; (a line of text)
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"RFS")=REASON
  1. ; FOR STUDY; the reason the study was conducted (a line of text)
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"V",n)=verifier IEN
  1. ; ^signature block name
  1. ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"TCOM",1)=techno-
  1. ; logist comment (a line of text)
  1. ; ^TMP($J,"RAE2",Patient IEN,"PRINT_SET")=null (IFF this is a printset)
  1. ; ^TMP($J,"RAE2",Patient IEN,"ORD")=name of ordered procedure for
  1. ; examsets and printsets
  1. ; ^TMP($J,"RAE2",Patient IEN,"ORD",case IEN)=name of ordered procedure
  1. ; for that case; not part of an examset or printset
  1. ;
  1. ; parse out RADFN & RADTI
  1. N RADELIM,RADFN,RADTI,RACNI,RAINVXDT,RAPSET
  1. S RADELIM=$$DEL(X) Q:RADELIM=""
  1. ; Quit if no Pat. DFN -or- no inv. exam DT
  1. S RADFN=$P(X,RADELIM),RADTI=$P(X,RADELIM,2)
  1. Q:RADFN'>0 Q:RADTI'>0
  1. S RAPSET=0 ;referenced in RAO7PC2
  1. ;
  1. ; if RACNI get our single record and quit
  1. I $L(X,RADELIM)=3 D
  1. .N RACNI,RAY3,RAQRYST
  1. .S RACNI=$P(X,RADELIM,3)
  1. .Q:RACNI'>0 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. .S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. .; if the order of the exam status is zero (canceled) quit
  1. .S RAQRYST=$P($G(^RA(72,+$P(RAY3,U,3),0)),U,3) Q:RAQRYST=0
  1. .K ^TMP($J,"RAE2") S RAINVXDT=RADTI
  1. .D CASE^RAO7PC2(RACNI) D SVTCOM^RAUTL11(RADFN,RADTI,RACNI) ;P18 mod by SS
  1. .Q
  1. ; if RACNI not present, get RACNI
  1. E D
  1. .K:'$D(RAXSET)#2 ^TMP($J,"RAE2") ;don't kill if called from EN30
  1. .N RACNI,RAY3,RAQRYST S RACNI=0
  1. .F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D
  1. ..Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. ..S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. ..;
  1. ..; get the exam status pointer, find the order number
  1. ..; quit if the order number is zero ('canceled')
  1. ..; even if you allow canceling of 'complete' studies
  1. ..; & allow reports on canceled studies the 'Cancel an
  1. ..; Exam' option prevents the cancel action
  1. ..;
  1. ..S RAQRYST=$P($G(^RA(72,+$P(RAY3,U,3),0)),U,3) Q:RAQRYST=0
  1. ..S RAINVXDT=RADTI D CASE^RAO7PC2(RACNI)
  1. ..D SVTCOM^RAUTL11(RADFN,RADTI,RACNI) ;P18 save TCOM in ^TMP
  1. ..S RAPSET=0 ;P18 modified
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. EN30(RAOIFN) ; DBIA#2266 - Return narrative text for exam(s). To be used
  1. ; with the EN3 entry point above.
  1. ; Input: RAOIFN -> the ien of Rad/Nuc Med Order
  1. K ^TMP($J,"RAE2")
  1. Q:'RAOIFN ; order passed in as 0 or null
  1. Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order
  1. Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order
  1. N RADFN,RADTI,RACNI,RAXSET,RAY2
  1. S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN
  1. ;
  1. ; This order IEN will be unique for patient 'RADFN'
  1. ; but this same order could be associated with more
  1. ; than one study.
  1. ;
  1. S RADTI=0 F S RADTI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI)) Q:RADTI'>0 D
  1. .S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0)),RAXSET=$P(RAY2,U,5)
  1. .; if RAXSET=1 we have a exam/printset
  1. .I RAXSET D EN3(RADFN_"^"_RADTI) Q ; exam set, hit EN3 code
  1. .; multiple studies can be tied to the same order when an exam is
  1. .; canceled (order on 'hold')
  1. .S RACNI=0
  1. .F S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RACNI)) Q:'RACNI D
  1. ..D EN3(RADFN_"^"_RADTI_"^"_RACNI)
  1. ..Q
  1. .Q
  1. Q
  1. EN4(RABBRV,RAARY) ; Return Imaging Locations
  1. ; Input: RABBRV-> Abbreviation for I-Type RAARY-> data storage array
  1. ;
  1. ; Output:
  1. ; array name(location IEN)=File 79.1 IEN^File 44 name^division IEN
  1. ; ^division name
  1. ;
  1. Q:RABBRV']"" ; quit no I-Type abbreviation
  1. Q:RAARY']"" ; quit no data storage array
  1. N RADIV,RAITY,RALOC,RAX,RASUP
  1. S RAITY=+$O(^RA(79.2,"C",RABBRV,0)) Q:'RAITY
  1. S RAX=0 F S RAX=$O(^RA(79.1,"BIMG",RAITY,RAX)) Q:RAX'>0 D
  1. . S RADIV(79)=$G(^RA(79.1,RAX,"DIV"))
  1. . S RALOC(0)=$G(^RA(79.1,RAX,0))
  1. . Q:$P(RALOC(0),"^",19)]"" ;inactive DT present, can't be a future DT
  1. . ;p178/KML - Check new I-LOC parameter to suppress sumbitting orders to it in CPRS
  1. . S RASUP=$$GET1^DIQ(79.1,RAX,.1) Q:$G(RASUP)["Y"
  1. . S RALOC=$P($G(^SC(+RALOC(0),0)),U)
  1. . S RALOC=$S(RALOC]"":RALOC,1:"Unknown")
  1. . S RADIV=+$P($G(^RA(79,+RADIV(79),0)),U),RADIV(4)=$G(^DIC(4,RADIV,0))
  1. . S RADIV=$S($P(RADIV(4),U)]"":$P(RADIV(4),U),1:"Unknown")
  1. . S @(RAARY_"("_RAX_")")=RAX_U_RALOC_U_+RADIV(79)_U_RADIV
  1. . Q
  1. Q
  1. CASE(RAOIFN,RARRAY) ; Return the case numbers and the total number of
  1. ; case numbers associated with a particular order.
  1. ; Input: RAOIFN-order ien (75.1)
  1. ; RARRAY-data storage (local array)
  1. ; Return: RATTL-n^x where n is the number of cases in the array
  1. ; x=PRINTSET if a single report covers many cases.
  1. ; -1 if error (invalid order ien)
  1. ; -2 no registered case to date -OR- case(s) cancelled
  1. ; If -1 or -2, second piece of RATTL gives the reason
  1. ; RARRAY-local data array, array_name(case #)
  1. N RATTL S RATTL="" D CASE^RAO7PC1A
  1. Q RATTL
  1. DEL(X) ; Determine the delimiter used to seperate the data
  1. ; Input: 'X'-> data seperated by a delimiter (first & second pieces
  1. ; will follow null)
  1. N Y,Z
  1. F Y="^","~","\","&",";","-"," " S Z=$F(X,Y) I +Z Q
  1. Q $S(+Z>0:Y,1:"") ; pass back the delimiter used, or null if not found
  1. ;