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