- 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 Mar 13, 2025@21:38:47 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
