ORQQRA ; slc/CLA - Functions which return patient radiology/nuclear med data ;12/15/97
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
LIST(ORY,ORPT,ORSDT,OREDT,ORMAX) ; return patient's radiological procedures (max. number) between start date/time and end date/time:
;ORY: return variable, results are returned in the format: radiology id^
; procedure name^diagnostic code^report status^abnormal flag
;ORPT: patient identifier from Patient File [#2]
;ORSDT: start date/time in Fileman format
;OREDT: end date/time in Fileman format
;ORMAX: maximum number of procedures to return
N DIFF,ORSRV,ORLOC
;
;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
;reliably determined, and many simultaneous outpt locations can occur):
I +$G(ORPT)>0 D
.N DFN S DFN=ORPT,VA200="" D OERR^VADPT
.I +$G(VAIN(4))>0 S ORLOC=+$G(^DIC(42,+$G(VAIN(4)),44))
.K VA200,VAIN
;
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
I '$L($G(ORSDT)) D
.S DIFF=$$GET^XPAR("USR^LOC.`"_$G(ORLOC)_"^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORQQRA SEARCH RANGE",1,"E")
.D DT^DILF("T","T-"_DIFF,.ORSDT,"","")
.I ORSDT=-1 S ORY(1)="^Error in date range." Q
I '$L($G(OREDT)) D NOW^%DTC S OREDT=+% K %
K ^TMP($J,"RAE1")
D EN1^RAO7PC1(ORPT,ORSDT,OREDT,ORMAX)
N I,RAID S I=1,RAID=0
F S RAID=$O(^TMP($J,"RAE1",+ORPT,RAID)) Q:RAID<1 D
.S ORY(I)=RAID_"^"_^TMP($J,"RAE1",+ORPT,RAID),I=I+1
K ^TMP($J,"RAE1")
Q
DETAIL(Y,PATIENT,INVDT,CASE) ; RETURN DETAILED NARRATIVE FOR A RAD PROC
N RADID S RADID=PATIENT_"^"_INVDT_"^"_CASE
K ^TMP($J,"RAE2")
D EN3^RAO7PC1(RADID)
N PROC,CASE,I,J,CR S PROC="",CASE="",I=1,J=0,CR=$CHAR(13)
S CASE=$O(^TMP($J,"RAE2",PATIENT,CASE)) Q:CASE="" D
.S PROC=$O(^TMP($J,"RAE2",PATIENT,CASE,PROC)) Q:PROC="" D
..S Y(I)="Procedure: "_PROC_" Report Status: "_$P(^(PROC),U)
..S Y(I)=Y(I)_" Case No. "_CASE,I=I+1
..S Y(I)=CR,I=I+1,Y(I)="Diagnostic Code: "_^(PROC,"D",1),I=I+1
..I $G(^TMP($J,"RAE2",PATIENT,CASE,PROC,"I",1))'="" D
...S Y(I)=CR,I=I+1,Y(I)="Impression: ",I=I+1
...F S J=$O(^TMP($J,"RAE2",PATIENT,CASE,PROC,"I",J)) Q:J<1 S Y(I)=^(J),I=I+1
..I $G(^TMP($J,"RAE2",PATIENT,CASE,PROC,"R",1))'="" D
...S Y(I)=CR,I=I+1,Y(I)="Report: ",I=I+1,J=0
...F S J=$O(^TMP($J,"RAE2",PATIENT,CASE,PROC,"R",J)) Q:J<1 S Y(I)=^(J),I=I+1
..S Y(I)=CR,I=I+1,Y(I)="Verified by: "_$P($G(^TMP($J,"RAE2",PATIENT,CASE,PROC,"V")),U,2)
K ^TMP($J,"RAE2")
Q
SEVEN(Y,PATIENT) ; RETURN PATIENT'S RADIOLOGY PROCEDURES FOR THE PAST SEVEN DAYS
K ^TMP($J,"RAE7")
D EN2^RAO7PC1(PATIENT)
N I,RAID S I=1,RAID=0
F S RAID=$O(^TMP($J,"RAE7",+PATIENT,RAID)) Q:RAID<1 D
.S Y(I)=RAID_"^"_^TMP($J,"RAE7",+PATIENT,RAID),I=I+1
K ^TMP($J,"RAE7")
Q
CM(ORQOI) ; extrinic funct. returns contrast media used by the procedure
; and/or if the procedure is a cholecystogram
; B = barium, M = unspecified contrast media, C = cholecystogram
N CMT
S CMT=$G(^ORD(101.43,ORQOI,"RA"))
I $L($G(CMT)) S CMT=$P(CMT,U)
Q CMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQRA 3021 printed Sep 23, 2025@20:10:06 Page 2
ORQQRA ; slc/CLA - Functions which return patient radiology/nuclear med data ;12/15/97
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
LIST(ORY,ORPT,ORSDT,OREDT,ORMAX) ; return patient's radiological procedures (max. number) between start date/time and end date/time:
+1 ;ORY: return variable, results are returned in the format: radiology id^
+2 ; procedure name^diagnostic code^report status^abnormal flag
+3 ;ORPT: patient identifier from Patient File [#2]
+4 ;ORSDT: start date/time in Fileman format
+5 ;OREDT: end date/time in Fileman format
+6 ;ORMAX: maximum number of procedures to return
+7 NEW DIFF,ORSRV,ORLOC
+8 ;
+9 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
+10 ;reliably determined, and many simultaneous outpt locations can occur):
+11 IF +$GET(ORPT)>0
Begin DoDot:1
+12 NEW DFN
SET DFN=ORPT
SET VA200=""
DO OERR^VADPT
+13 IF +$GET(VAIN(4))>0
SET ORLOC=+$GET(^DIC(42,+$GET(VAIN(4)),44))
+14 KILL VA200,VAIN
End DoDot:1
+15 ;
+16 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+17 IF '$LENGTH($GET(ORSDT))
Begin DoDot:1
+18 SET DIFF=$$GET^XPAR("USR^LOC.`"_$GET(ORLOC)_"^SRV.`"_$GET(ORSRV)_"^DIV^SYS^PKG","ORQQRA SEARCH RANGE",1,"E")
+19 DO DT^DILF("T","T-"_DIFF,.ORSDT,"","")
+20 IF ORSDT=-1
SET ORY(1)="^Error in date range."
QUIT
End DoDot:1
+21 IF '$LENGTH($GET(OREDT))
DO NOW^%DTC
SET OREDT=+%
KILL %
+22 KILL ^TMP($JOB,"RAE1")
+23 DO EN1^RAO7PC1(ORPT,ORSDT,OREDT,ORMAX)
+24 NEW I,RAID
SET I=1
SET RAID=0
+25 FOR
SET RAID=$ORDER(^TMP($JOB,"RAE1",+ORPT,RAID))
if RAID<1
QUIT
Begin DoDot:1
+26 SET ORY(I)=RAID_"^"_^TMP($JOB,"RAE1",+ORPT,RAID)
SET I=I+1
End DoDot:1
+27 KILL ^TMP($JOB,"RAE1")
+28 QUIT
DETAIL(Y,PATIENT,INVDT,CASE) ; RETURN DETAILED NARRATIVE FOR A RAD PROC
+1 NEW RADID
SET RADID=PATIENT_"^"_INVDT_"^"_CASE
+2 KILL ^TMP($JOB,"RAE2")
+3 DO EN3^RAO7PC1(RADID)
+4 NEW PROC,CASE,I,J,CR
SET PROC=""
SET CASE=""
SET I=1
SET J=0
SET CR=$CHAR(13)
+5 SET CASE=$ORDER(^TMP($JOB,"RAE2",PATIENT,CASE))
if CASE=""
QUIT
Begin DoDot:1
+6 SET PROC=$ORDER(^TMP($JOB,"RAE2",PATIENT,CASE,PROC))
if PROC=""
QUIT
Begin DoDot:2
+7 SET Y(I)="Procedure: "_PROC_" Report Status: "_$PIECE(^(PROC),U)
+8 SET Y(I)=Y(I)_" Case No. "_CASE
SET I=I+1
+9 SET Y(I)=CR
SET I=I+1
SET Y(I)="Diagnostic Code: "_^(PROC,"D",1)
SET I=I+1
+10 IF $GET(^TMP($JOB,"RAE2",PATIENT,CASE,PROC,"I",1))'=""
Begin DoDot:3
+11 SET Y(I)=CR
SET I=I+1
SET Y(I)="Impression: "
SET I=I+1
+12 FOR
SET J=$ORDER(^TMP($JOB,"RAE2",PATIENT,CASE,PROC,"I",J))
if J<1
QUIT
SET Y(I)=^(J)
SET I=I+1
End DoDot:3
+13 IF $GET(^TMP($JOB,"RAE2",PATIENT,CASE,PROC,"R",1))'=""
Begin DoDot:3
+14 SET Y(I)=CR
SET I=I+1
SET Y(I)="Report: "
SET I=I+1
SET J=0
+15 FOR
SET J=$ORDER(^TMP($JOB,"RAE2",PATIENT,CASE,PROC,"R",J))
if J<1
QUIT
SET Y(I)=^(J)
SET I=I+1
End DoDot:3
+16 SET Y(I)=CR
SET I=I+1
SET Y(I)="Verified by: "_$PIECE($GET(^TMP($JOB,"RAE2",PATIENT,CASE,PROC,"V")),U,2)
End DoDot:2
End DoDot:1
+17 KILL ^TMP($JOB,"RAE2")
+18 QUIT
SEVEN(Y,PATIENT) ; RETURN PATIENT'S RADIOLOGY PROCEDURES FOR THE PAST SEVEN DAYS
+1 KILL ^TMP($JOB,"RAE7")
+2 DO EN2^RAO7PC1(PATIENT)
+3 NEW I,RAID
SET I=1
SET RAID=0
+4 FOR
SET RAID=$ORDER(^TMP($JOB,"RAE7",+PATIENT,RAID))
if RAID<1
QUIT
Begin DoDot:1
+5 SET Y(I)=RAID_"^"_^TMP($JOB,"RAE7",+PATIENT,RAID)
SET I=I+1
End DoDot:1
+6 KILL ^TMP($JOB,"RAE7")
+7 QUIT
CM(ORQOI) ; extrinic funct. returns contrast media used by the procedure
+1 ; and/or if the procedure is a cholecystogram
+2 ; B = barium, M = unspecified contrast media, C = cholecystogram
+3 NEW CMT
+4 SET CMT=$GET(^ORD(101.43,ORQOI,"RA"))
+5 IF $LENGTH($GET(CMT))
SET CMT=$PIECE(CMT,U)
+6 QUIT CMT
