PXRHS05 ;ISL/SBW,PKR - PCE V EXAM extract routine ;03/21/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**13,211,217**;Aug 12, 1996;Build 134
; Extract returns EXAM data
EXAM(DFN,ENDDT,BEGDT,OCCLIM) ; Control branching
;INPUT : DFN - Pointer to PATIENT file (#2)
; ENDDT - Ending date/time in internal FileMan format
; - Defaults to today's date at 11:59 pm
; BEGDT - Beginning date/time in internal FileMan format
; - Defaults to one year prior to today's date
; OCCLIM - Maximum # of each type of exam returned
;OUTPUT :
; Data from V EXAM (9000010.13) file
; ^TMP("PXE,$J,EXAM,InvDt,IFN,0) = PRINT NAME or EXAM [E;.01]
; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
; ^ RESULTS CODE [I;.04] ^ RESULTS [E;.04]
; ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204] ^
; ^TMP("PXE",$J,EXAM,InvDt,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
; ^ HOSP. LOC. ABBREVIATION [E;44;1]
; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
; ^TMP("PXE",$J,EXAM,InvDt,IFN,"S") = DATA SOURCE [E;81203]
;
; [] = [I(nternal)/E(xternal); Optional file #; Record #]
; Subscripts:
; EXAM - EXAM name
; InvDt - Inverse FileMan date of DATE OF event or visit
; IFN - Internal Record #
;
Q:$G(DFN)']""!'$D(^PXRMINDX(9000010.13,"PI",DFN))
N CNT,COMMENT,DATASRC,EPROV,EXAM,EXAMIEN,EXDT,HLOC,HLOCABB
N IBEGDT,IDT,IENDDT,OPROV,PNAME,PXDT,PXEX,PXIFN
N REC,RESULTC,RESULT,TMP0,TMP12,TMP220,TMP811,TMP812,VDATA
S:+$G(OCCLIM)'>0 OCCLIM=999
S:+$G(BEGDT)'>0 BEGDT=DT-10000
S:+$G(ENDDT)'>0 ENDDT=DT_".235959"
;Chg regular dt/time to inverted dt/time
S IBEGDT=9999999-ENDDT,IENDDT=9999999-BEGDT
K ^TMP("PXE",$J)
S PXEX=""
F S PXEX=$O(^PXRMINDX(9000010.13,"PI",DFN,PXEX)) Q:PXEX="" D
. S PXDT=ENDDT+.01,CNT=0
. F S PXDT=$O(^PXRMINDX(9000010.13,"PI",DFN,PXEX,PXDT),-1) Q:PXDT'>0!(PXDT<BEGDT) D Q:CNT'<OCCLIM
.. S PXIFN=0
.. F S PXIFN=$O(^PXRMINDX(9000010.13,"PI",DFN,PXEX,PXDT,PXIFN)) Q:PXIFN'>0 D Q:CNT'<OCCLIM
... S TMP0=$G(^AUPNVXAM(PXIFN,0))
... S EXAMIEN=$P(TMP0,U,1)
... Q:EXAMIEN=""
... S TMP12=$G(^AUPNVXAM(PXIFN,12))
... S TMP220=$G(^AUPNVXAM(PXIFN,220))
... I TMP220'="" S TMP220=TMP220_U_$P(^AUTTEXAM(EXAMIEN,220),U,6)
... S TMP811=$G(^AUPNVXAM(PXIFN,811))
... S TMP812=$G(^AUPNVXAM(PXIFN,812))
... S VDATA=$$GETVDATA^PXRHS03($P(TMP0,U,3))
... S EXAM=$P(^AUTTEXAM(EXAMIEN,0),U,1)
... S PNAME=$P($G(^AUTTEXAM(EXAMIEN,200)),U,1)
... I PNAME="" S PNAME=EXAM
... S EXDT=$P(TMP12,U,1)
... S:EXDT']"" EXDT=$P(VDATA,U,1)
... S IDT=9999999-$P(EXDT,".",1)
... I IDT<IBEGDT!(IDT>IENDDT) Q ;Only get data within date range
... S RESULTC=$P(TMP0,U,4)
... S RESULT=$$EXTERNAL^DILFD(9000010.13,.04,"",$P(TMP0,U,4))
... S OPROV=$$GET1^DIQ(9000010.13,PXIFN_",",1202)
... S EPROV=$$GET1^DIQ(9000010.13,PXIFN_",",1202)
... S HLOC=$P(VDATA,U,5)
... S HLOCABB=$P(VDATA,U,6)
... S DATASRC=$P(TMP812,U,3)
... S COMMENT=TMP811
... ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,0)=PNAME_U_EXDT_U_RESULTC_U_RESULT_U_OPROV_U_EPROV
... ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
... ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,"COM")=COMMENT
... ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,"MEASUREMENT")=TMP220
... ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,"S")=DATASRC
...;
... S ^TMP("PXE",$J,IDT,EXAM,PXIFN,0)=PNAME_U_EXDT_U_RESULTC_U_RESULT_U_OPROV_U_EPROV
... S ^TMP("PXE",$J,IDT,EXAM,PXIFN,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
... S ^TMP("PXE",$J,IDT,EXAM,PXIFN,"COM")=COMMENT
... S ^TMP("PXE",$J,IDT,EXAM,PXIFN,"MEASUREMENT")=TMP220
... S ^TMP("PXE",$J,IDT,EXAM,PXIFN,"S")=DATASRC
... S CNT=CNT+1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRHS05 3775 printed Dec 13, 2024@02:30:26 Page 2
PXRHS05 ;ISL/SBW,PKR - PCE V EXAM extract routine ;03/21/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13,211,217**;Aug 12, 1996;Build 134
+2 ; Extract returns EXAM data
EXAM(DFN,ENDDT,BEGDT,OCCLIM) ; Control branching
+1 ;INPUT : DFN - Pointer to PATIENT file (#2)
+2 ; ENDDT - Ending date/time in internal FileMan format
+3 ; - Defaults to today's date at 11:59 pm
+4 ; BEGDT - Beginning date/time in internal FileMan format
+5 ; - Defaults to one year prior to today's date
+6 ; OCCLIM - Maximum # of each type of exam returned
+7 ;OUTPUT :
+8 ; Data from V EXAM (9000010.13) file
+9 ; ^TMP("PXE,$J,EXAM,InvDt,IFN,0) = PRINT NAME or EXAM [E;.01]
+10 ; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
+11 ; ^ RESULTS CODE [I;.04] ^ RESULTS [E;.04]
+12 ; ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204] ^
+13 ; ^TMP("PXE",$J,EXAM,InvDt,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+14 ; ^ HOSP. LOC. ABBREVIATION [E;44;1]
+15 ; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
+16 ; ^TMP("PXE",$J,EXAM,InvDt,IFN,"S") = DATA SOURCE [E;81203]
+17 ;
+18 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
+19 ; Subscripts:
+20 ; EXAM - EXAM name
+21 ; InvDt - Inverse FileMan date of DATE OF event or visit
+22 ; IFN - Internal Record #
+23 ;
+24 if $GET(DFN)']""!'$DATA(^PXRMINDX(9000010.13,"PI",DFN))
QUIT
+25 NEW CNT,COMMENT,DATASRC,EPROV,EXAM,EXAMIEN,EXDT,HLOC,HLOCABB
+26 NEW IBEGDT,IDT,IENDDT,OPROV,PNAME,PXDT,PXEX,PXIFN
+27 NEW REC,RESULTC,RESULT,TMP0,TMP12,TMP220,TMP811,TMP812,VDATA
+28 if +$GET(OCCLIM)'>0
SET OCCLIM=999
+29 if +$GET(BEGDT)'>0
SET BEGDT=DT-10000
+30 if +$GET(ENDDT)'>0
SET ENDDT=DT_".235959"
+31 ;Chg regular dt/time to inverted dt/time
+32 SET IBEGDT=9999999-ENDDT
SET IENDDT=9999999-BEGDT
+33 KILL ^TMP("PXE",$JOB)
+34 SET PXEX=""
+35 FOR
SET PXEX=$ORDER(^PXRMINDX(9000010.13,"PI",DFN,PXEX))
if PXEX=""
QUIT
Begin DoDot:1
+36 SET PXDT=ENDDT+.01
SET CNT=0
+37 FOR
SET PXDT=$ORDER(^PXRMINDX(9000010.13,"PI",DFN,PXEX,PXDT),-1)
if PXDT'>0!(PXDT<BEGDT)
QUIT
Begin DoDot:2
+38 SET PXIFN=0
+39 FOR
SET PXIFN=$ORDER(^PXRMINDX(9000010.13,"PI",DFN,PXEX,PXDT,PXIFN))
if PXIFN'>0
QUIT
Begin DoDot:3
+40 SET TMP0=$GET(^AUPNVXAM(PXIFN,0))
+41 SET EXAMIEN=$PIECE(TMP0,U,1)
+42 if EXAMIEN=""
QUIT
+43 SET TMP12=$GET(^AUPNVXAM(PXIFN,12))
+44 SET TMP220=$GET(^AUPNVXAM(PXIFN,220))
+45 IF TMP220'=""
SET TMP220=TMP220_U_$PIECE(^AUTTEXAM(EXAMIEN,220),U,6)
+46 SET TMP811=$GET(^AUPNVXAM(PXIFN,811))
+47 SET TMP812=$GET(^AUPNVXAM(PXIFN,812))
+48 SET VDATA=$$GETVDATA^PXRHS03($PIECE(TMP0,U,3))
+49 SET EXAM=$PIECE(^AUTTEXAM(EXAMIEN,0),U,1)
+50 SET PNAME=$PIECE($GET(^AUTTEXAM(EXAMIEN,200)),U,1)
+51 IF PNAME=""
SET PNAME=EXAM
+52 SET EXDT=$PIECE(TMP12,U,1)
+53 if EXDT']""
SET EXDT=$PIECE(VDATA,U,1)
+54 SET IDT=9999999-$PIECE(EXDT,".",1)
+55 ;Only get data within date range
IF IDT<IBEGDT!(IDT>IENDDT)
QUIT
+56 SET RESULTC=$PIECE(TMP0,U,4)
+57 SET RESULT=$$EXTERNAL^DILFD(9000010.13,.04,"",$PIECE(TMP0,U,4))
+58 SET OPROV=$$GET1^DIQ(9000010.13,PXIFN_",",1202)
+59 SET EPROV=$$GET1^DIQ(9000010.13,PXIFN_",",1202)
+60 SET HLOC=$PIECE(VDATA,U,5)
+61 SET HLOCABB=$PIECE(VDATA,U,6)
+62 SET DATASRC=$PIECE(TMP812,U,3)
+63 SET COMMENT=TMP811
+64 ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,0)=PNAME_U_EXDT_U_RESULTC_U_RESULT_U_OPROV_U_EPROV
+65 ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
+66 ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,"COM")=COMMENT
+67 ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,"MEASUREMENT")=TMP220
+68 ;S ^TMP("PXE",$J,EXAM,IDT,PXIFN,"S")=DATASRC
+69 ;
+70 SET ^TMP("PXE",$JOB,IDT,EXAM,PXIFN,0)=PNAME_U_EXDT_U_RESULTC_U_RESULT_U_OPROV_U_EPROV
+71 SET ^TMP("PXE",$JOB,IDT,EXAM,PXIFN,1)=HLOC_U_HLOCABB_U_$PIECE(VDATA,U,2)_U_$PIECE(VDATA,U,4)
+72 SET ^TMP("PXE",$JOB,IDT,EXAM,PXIFN,"COM")=COMMENT
+73 SET ^TMP("PXE",$JOB,IDT,EXAM,PXIFN,"MEASUREMENT")=TMP220
+74 SET ^TMP("PXE",$JOB,IDT,EXAM,PXIFN,"S")=DATASRC
+75 SET CNT=CNT+1
End DoDot:3
if CNT'<OCCLIM
QUIT
End DoDot:2
if CNT'<OCCLIM
QUIT
End DoDot:1
+76 QUIT
+77 ;
