- 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 Jan 18, 2025@03:38:45 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 ;