| 1 | RAO7PC1 ;HISC/GJC,SS-Procedure Call utilities. ;12/9/02 08:41
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**1,16,18,26,36,45,75**;Mar 16, 1998;Build 4
|
|---|
| 3 | ;
|
|---|
| 4 | EN1(RADFN,RABDT,RAEDT,RAEXN,RACINC) ;
|
|---|
| 5 | ;
|
|---|
| 6 | ; DBIA#2043 - Return list of exams within date range
|
|---|
| 7 | ;
|
|---|
| 8 | ; ** See routines RAO7PC1A and RAO7PC2 for additional comments **
|
|---|
| 9 | ; ** and output node descriptions **
|
|---|
| 10 | ;
|
|---|
| 11 | ; Input: RADFN-> Patient IEN RABDT-> beginning date
|
|---|
| 12 | ; RAEDT-> ending date RAEXN-> max # of exams
|
|---|
| 13 | ; RACINC-> include cancelled exams? (1 if yes, default no)
|
|---|
| 14 | ;
|
|---|
| 15 | ; Output:
|
|---|
| 16 | ; ^TMP($J,"RAE1",Patient IEN,Exam ID)=Procedure name^Case number^
|
|---|
| 17 | ; Report status^Abnormal alert flag^Report ien^
|
|---|
| 18 | ; Exam status order #~Exam status name^
|
|---|
| 19 | ; Imaging location name^Imaging type abbr~
|
|---|
| 20 | ; Imaging type name^abnormal results flag^CPT Code
|
|---|
| 21 | ; ^CPRS Order ien^Images exist flag
|
|---|
| 22 | ;
|
|---|
| 23 | ;if there are one or more CPT modifiers:
|
|---|
| 24 | ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CMOD",n)=CPT Mod^CPT Mod Name
|
|---|
| 25 | ; n+1)=CPT Mod^CPT Mod Name
|
|---|
| 26 | ;
|
|---|
| 27 | ;if CPRS asks to display parent procs, and case is descendent of parent:
|
|---|
| 28 | ; ^TMP($J,"RAE1",Patient IEN,Exam ID,"CPRS")=memb of set^parent prc name
|
|---|
| 29 | ;
|
|---|
| 30 | ; Note: It is possible for the ^TMP global data returned to contain
|
|---|
| 31 | ; 'No Report' and a Report file ien for the same exam. This is
|
|---|
| 32 | ; because Imaging can create a report stub in the Report file,
|
|---|
| 33 | ; but no report interpretation exists and no status is assigned
|
|---|
| 34 | ; to the report record.
|
|---|
| 35 | ;
|
|---|
| 36 | ; Exam ID: exam date/time (inverse) concatenated with the case IEN
|
|---|
| 37 | ; Abnormal alert flag: Y or blank
|
|---|
| 38 | ; Abnormal results flag: Y or blank, may be turned on even if
|
|---|
| 39 | ; abnormal alert flag is not
|
|---|
| 40 | ;
|
|---|
| 41 | Q:'RADFN!('RABDT)!('RAEDT)
|
|---|
| 42 | N RAEXNP S RAEXNP=RAEXN ;save original value of RAEXN
|
|---|
| 43 | ; if last char RAEXNP has "P", then count max no. by parent and
|
|---|
| 44 | ; single, not by individual cases
|
|---|
| 45 | S RACINC=+$G(RACINC)
|
|---|
| 46 | Q:RABDT>RAEDT ; quit if ending date before beginning date
|
|---|
| 47 | K ^TMP($J,"RAE1") S RAEXN=+$G(RAEXN)
|
|---|
| 48 | S:$P(RABDT,".",2) RABDT=RABDT\1 S:$P(RAEDT,".",2) RAEDT=RAEDT\1
|
|---|
| 49 | N RABNOR,RACNST,RACNT,RACPT,RACSE,RADIAG,RAIBDT,RAIEDT,RAILOC,RAITY
|
|---|
| 50 | N RANO,RAPRC,RAREX,RARPT,RARPTST
|
|---|
| 51 | N RAXAM,RAXID,RAXIT,RAXSTAT,RABNORMR,RASHOCAN
|
|---|
| 52 | S RACNST=9999999.9999
|
|---|
| 53 | S RAIBDT=RACNST-(RAEDT+.9999),RAIEDT=RACNST-(RABDT-.0001)
|
|---|
| 54 | S (RACNT,RAXIT)=0
|
|---|
| 55 | F S RAIBDT=$O(^RADPT(RADFN,"DT",RAIBDT)) Q:RAIBDT'>0!(RAIBDT>RAIEDT) D Q:RAXIT
|
|---|
| 56 | . D SETDATA^RAO7PC1A ; obtain exam data, set ^TMP($J,"RAE1",Patient IEN,Exam ID)
|
|---|
| 57 | . Q
|
|---|
| 58 | Q
|
|---|
| 59 | EN2(RADFN) ;
|
|---|
| 60 | ;
|
|---|
| 61 | ; DBIA#2012 - Return last 7 days of non-cancelled exams
|
|---|
| 62 | ;
|
|---|
| 63 | ; Input: RADFN-> Patient IEN
|
|---|
| 64 | ;
|
|---|
| 65 | ; Output:
|
|---|
| 66 | ; ^TMP($J,"RAE7",Patient IEN,Exam ID)=procedure name^case number^
|
|---|
| 67 | ; report status^imaging location IEN^imaging location name^
|
|---|
| 68 | ; contrast medium or media used
|
|---|
| 69 | ; Note: Single characters in parenthesis indicate contrast
|
|---|
| 70 | ; involvement: (I)=Iodinated ionic; (N)=Iodinated non-ionic;
|
|---|
| 71 | ; (L)=Gadolinium; (C)=Oral Cholecystographic; (G)=Gastrografin;
|
|---|
| 72 | ; (B)=Barium; (M)=unspecified contrast media
|
|---|
| 73 | ;
|
|---|
| 74 | ; Exam ID: exam date/time (inverse) concatenated with the case IEN
|
|---|
| 75 | ;
|
|---|
| 76 | Q:'RADFN D EN2^RAO7PC1A Q
|
|---|
| 77 | ;
|
|---|
| 78 | EN3(X) ; DBIA#2265 - Return narrative text for exam(s)
|
|---|
| 79 | ; Input:
|
|---|
| 80 | ; X-> Exam id in one of two forms:
|
|---|
| 81 | ; 1) Pat. DFN^inv. exam date^Case IEN
|
|---|
| 82 | ; Retrieves a single report for a single exam
|
|---|
| 83 | ; 2) Pat. DFN^inv. exam date^
|
|---|
| 84 | ; Retrieves all reports for a set of exams ordered on one order
|
|---|
| 85 | ;
|
|---|
| 86 | ; Note: Input delimiter can be any of the following: ^~\&;-
|
|---|
| 87 | ; a delimiter may be a single space i.e, " "
|
|---|
| 88 | ;
|
|---|
| 89 | ; Output:
|
|---|
| 90 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name)=report status^
|
|---|
| 91 | ; abnormal alert flag^CPRS Order ien^amended report?
|
|---|
| 92 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"CM",n)=contrast
|
|---|
| 93 | ; media used during exam (internal)^contrast media used during exam
|
|---|
| 94 | ; (external)
|
|---|
| 95 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"D",n)=diagnostic
|
|---|
| 96 | ; code (n=1, this is the primary code)
|
|---|
| 97 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"H",n)=clin history
|
|---|
| 98 | ; (a line of text)
|
|---|
| 99 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"I",n)=impression
|
|---|
| 100 | ; (a line of text)
|
|---|
| 101 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"M",n)=modifier
|
|---|
| 102 | ; (external format)
|
|---|
| 103 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"P")=primary
|
|---|
| 104 | ; interpreting staff IEN^primary interpreting resident IEN^date
|
|---|
| 105 | ; report entered
|
|---|
| 106 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"R",n)=report
|
|---|
| 107 | ; (a line of text)
|
|---|
| 108 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"RFS")=REASON
|
|---|
| 109 | ; FOR STUDY; the reason the study was conducted (a line of text)
|
|---|
| 110 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"V",n)=verifier IEN
|
|---|
| 111 | ; ^signature block name
|
|---|
| 112 | ; ^TMP($J,"RAE2",Patient IEN,case IEN,procedure name,"TCOM",1)=techno-
|
|---|
| 113 | ; logist comment (a line of text)
|
|---|
| 114 | ; ^TMP($J,"RAE2",Patient IEN,"PRINT_SET")=null (IFF this is a printset)
|
|---|
| 115 | ; ^TMP($J,"RAE2",Patient IEN,"ORD")=name of ordered procedure for
|
|---|
| 116 | ; examsets and printsets
|
|---|
| 117 | ; ^TMP($J,"RAE2",Patient IEN,"ORD",case IEN)=name of ordered procedure
|
|---|
| 118 | ; for that case; not part of an examset or printset
|
|---|
| 119 | ;
|
|---|
| 120 | K RAU,^TMP($J,"RAE2") S RAU=$$DEL(X)
|
|---|
| 121 | I RAU="" K RAU Q
|
|---|
| 122 | Q:'$P(X,RAU)!('$P(X,RAU,2)) ; Quit if no Pat. DFN -or- no inv. exam DT
|
|---|
| 123 | N RACIEN,RADFN,RAINVXDT,RAPSET,Y S RAPSET=0
|
|---|
| 124 | S RADFN=$P(X,RAU),RAINVXDT=$P(X,RAU,2),RACIEN=+$P(X,RAU,3)
|
|---|
| 125 | K RAU Q:'($D(^RADPT(RADFN,"DT",RAINVXDT,0))#2)
|
|---|
| 126 | SS I RACIEN D CASE^RAO7PC2(RACIEN) D SVTCOM^RAUTL11(RADFN,RAINVXDT,RACIEN) Q ;P18 mod by SS
|
|---|
| 127 | S Y=0
|
|---|
| 128 | F S Y=$O(^RADPT(RADFN,"DT",RAINVXDT,"P",Y)) Q:Y'>0 D
|
|---|
| 129 | . D CASE^RAO7PC2(Y)
|
|---|
| 130 | . D SVTCOM^RAUTL11(RADFN,RAINVXDT,Y) ;P18 save TCOM in ^TMP
|
|---|
| 131 | . S RAPSET=0 ;P18 modified
|
|---|
| 132 | . Q
|
|---|
| 133 | Q
|
|---|
| 134 | ;
|
|---|
| 135 | EN30(RAOIFN) ; DBIA#2266 - Return narrative text for exam(s). To be used
|
|---|
| 136 | ; with the EN3 entry point above.
|
|---|
| 137 | ; Input: RAOIFN -> the ien of Rad/Nuc Med Order
|
|---|
| 138 | Q:'RAOIFN ; order passed in as 0 or null
|
|---|
| 139 | Q:'$D(^RAO(75.1,RAOIFN,0)) ; no such order
|
|---|
| 140 | Q:'$D(^RADPT("AO",RAOIFN)) ; no exam associated with this order
|
|---|
| 141 | N RADFN,RADTI,RACNI,RAXSET
|
|---|
| 142 | S RADFN=+$O(^RADPT("AO",RAOIFN,0)) Q:'RADFN
|
|---|
| 143 | S RADTI=+$O(^RADPT("AO",RAOIFN,RADFN,0)) Q:'RADTI
|
|---|
| 144 | S RAXSET=+$P($G(^RADPT(RADFN,"DT",RADTI,0)),"^",5) ; set if RAXSET=1
|
|---|
| 145 | I RAXSET D EN3(RADFN_"^"_RADTI_"^") Q ; exam set, hit EN3 code
|
|---|
| 146 | ; the following code is executed for non-exam set examinations
|
|---|
| 147 | S RACNI=+$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0)) Q:'RACNI
|
|---|
| 148 | D EN3(RADFN_"^"_RADTI_"^"_RACNI)
|
|---|
| 149 | Q
|
|---|
| 150 | EN4(RABBRV,RAARY) ; Return Imaging Locations
|
|---|
| 151 | ; Input: RABBRV-> Abbreviation for I-Type RAARY-> data storage array
|
|---|
| 152 | ;
|
|---|
| 153 | ; Output:
|
|---|
| 154 | ; array name(location IEN)=File 79.1 IEN^File 44 name^division IEN
|
|---|
| 155 | ; ^division name
|
|---|
| 156 | ;
|
|---|
| 157 | Q:RABBRV']"" ; quit no I-Type abbreviation
|
|---|
| 158 | Q:RAARY']"" ; quit no data storage array
|
|---|
| 159 | N RADIV,RAITY,RALOC,RAX
|
|---|
| 160 | S RAITY=+$O(^RA(79.2,"C",RABBRV,0)) Q:'RAITY
|
|---|
| 161 | S RAX=0 F S RAX=$O(^RA(79.1,"BIMG",RAITY,RAX)) Q:RAX'>0 D
|
|---|
| 162 | . S RADIV(79)=$G(^RA(79.1,RAX,"DIV"))
|
|---|
| 163 | . S RALOC(0)=$G(^RA(79.1,RAX,0))
|
|---|
| 164 | . Q:$P(RALOC(0),"^",19)]"" ;inactive DT present, can't be a future DT
|
|---|
| 165 | . S RALOC=$P($G(^SC(+RALOC(0),0)),U)
|
|---|
| 166 | . S RALOC=$S(RALOC]"":RALOC,1:"Unknown")
|
|---|
| 167 | . S RADIV=+$P($G(^RA(79,+RADIV(79),0)),U),RADIV(4)=$G(^DIC(4,RADIV,0))
|
|---|
| 168 | . S RADIV=$S($P(RADIV(4),U)]"":$P(RADIV(4),U),1:"Unknown")
|
|---|
| 169 | . S @(RAARY_"("_RAX_")")=RAX_U_RALOC_U_+RADIV(79)_U_RADIV
|
|---|
| 170 | . Q
|
|---|
| 171 | Q
|
|---|
| 172 | CASE(RAOIFN,RARRAY) ; Return the case numbers and the total number of
|
|---|
| 173 | ; case numbers associated with a particular order.
|
|---|
| 174 | ; Input: RAOIFN-order ien (75.1)
|
|---|
| 175 | ; RARRAY-data storage (local array)
|
|---|
| 176 | ; Return: RATTL-n^x where n is the number of cases in the array
|
|---|
| 177 | ; x=PRINTSET if a single report covers many cases.
|
|---|
| 178 | ; -1 if error (invalid order ien)
|
|---|
| 179 | ; -2 no registered case to date -OR- case(s) cancelled
|
|---|
| 180 | ; If -1 or -2, second piece of RATTL gives the reason
|
|---|
| 181 | ; RARRAY-local data array, array_name(case #)
|
|---|
| 182 | N RATTL S RATTL="" D CASE^RAO7PC1A
|
|---|
| 183 | Q RATTL
|
|---|
| 184 | DEL(X) ; Determine the delimiter used to seperate the data
|
|---|
| 185 | ; Input: 'X'-> data seperated by a delimiter (first & second pieces
|
|---|
| 186 | ; will follow null)
|
|---|
| 187 | N Y,Z
|
|---|
| 188 | F Y="^","~","\","&",";","-"," " S Z=$F(X,Y) I +Z Q
|
|---|
| 189 | Q $S(+Z>0:Y,1:"") ; pass back the delimiter used, or null if not found
|
|---|
