PXRHS07 ;ISL/PKR - PCE V HEALTH FACTORS extract routine ;05/26/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**13,123,211,217**;Aug 12, 1996;Build 134
; Extract returns HEALTH FACTORS data
;Original version by SBW
HF(DFN,BEGDT,ENDDT,OCCLIM,ITEMS) ; Control branching
;INPUT : DFN - Pointer to PATIENT file (#2)
; BEGDT - Beginning date/time in internal FileMan format
; - Defaults to one year prior to today's date
; ENDDT - Ending date/time in internal FileMan format
; - Defaults to today's date at 11:59 pm
; OCCLIM - Maximum number of days for which data is returned
; for each Health Factors item.
; If multiple visits on a given day, all data for
; these visit will be returned.
; Note: If event date is used, it may appear that too
; many occurrences are retrieved but it is
; it is based on visit date not event date.
; ITEMS - Optional array containing a selected list of
; HF Categories. If not used will get all categories
; of health factors.
;OUTPUT :
; Data from V HEALTH FACTORS (9000010.23) file
; ^TMP("PXF,$J,HFC,InvDt,HF,IFN,0) = PRINT NAME or Health Factor [E;.01]
; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
; ^ SHORT NAME [E;9999999.64;.04] ^ LEVEL/SEVERITY [E;.04]
; ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204]
; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
; ^TMP("PXF",$J,HFC,InvDt,HF,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("PXF",$J,HFC,InvDt,HF,IFN,"S") = DATA SOURCE [E;81203]
;
; [] = [I(nternal)/E(xternal); Optional file #; Record #]
; Subscripts:
; HFC - Health Factor Category name
; InvDt - Inverse FileMan date of Event Date and Time or Visit
; HF - Health Factor name
; IFN - Internal Record #
;
Q:$G(DFN)']""!'$D(^PXRMINDX(9000010.23,"PI",DFN))
S:+$G(OCCLIM)'>0 OCCLIM=999
S:+$G(BEGDT)'>0 BEGDT=DT-10000
S:+$G(ENDDT)'>0 ENDDT=DT_".235959"
K ^TMP("PXF",$J)
I '$D(ITEMS) D HFALL(DFN,BEGDT,ENDDT,OCCLIM)
I $D(ITEMS) D HFSELECT(DFN,BEGDT,ENDDT,.ITEMS,OCCLIM)
Q
;
;====================
ADDHF(HFIEN,VHFIEN,BEGDT,ENDDT) ;Check a specific health factor and determine
;if it should be added to the list. Return 1 if it was added to the
;list, 0 if it was not.
N COMMENT,DATASRC,EPROV,EVENTDT,HFCAT,HFCNAME,HFNAME,HLOC,HLOCABB,IDT
N OPROV,LEVEL,PNAME,SNAME,TEMP,TMP0,TMP12,TMP220,TMP811,TMP812,VDATA
S TEMP=^AUTTHF(HFIEN,0)
;Is Display on Health Summary YES?
I $P(TEMP,U,8)'="Y" Q 0
S TMP0=$G(^AUPNVHF(VHFIEN,0))
S TMP12=$G(^AUPNVHF(VHFIEN,12))
S VDATA=$$GETVDATA^PXRHS03($P(TMP0,U,3))
S EVENTDT=$P(TMP12,U,1)
;If there is no Event Date use the Visit Date.
I EVENTDT="" S EVENTDT=$P(VDATA,U,1)
;Is it in the date range?
I (EVENTDT<BEGDT)!(EVENTDT>ENDDT) Q 0
S HFNAME=$P(TEMP,U,1)
S SNAME=$P(TEMP,U,4)
S PNAME=$P($G(^AUTTHF(HFIEN,200)),U,1)
I PNAME="" S PNAME=HFNAME
S HFCAT=$P(TEMP,U,3)
I HFCAT="" Q 0
S HFCNAME=$P($G(^AUTTHF(HFCAT,200)),U,1)
I HFCNAME="" S HFCNAME=$P(^AUTTHF(HFCAT,0),U,1)
S TMP220=$G(^AUPNVHF(VHFIEN,220))
I TMP220'="" S TMP220=TMP220_U_$P(^AUTTHF(HFIEN,220),U,6)
S TMP811=$G(^AUPNVHF(VHFIEN,811))
S TMP812=$G(^AUPNVHF(VHFIEN,812))
S LEVEL=$$EXTERNAL^DILFD(9000010.23,.04,"",$P(TMP0,U,4))
S OPROV=$$GET1^DIQ(9000010.23,VHFIEN_",",1202)
S EPROV=$$GET1^DIQ(9000010.23,VHFIEN_",",1204)
S HLOC=$P(VDATA,U,5)
S HLOCABB=$P(VDATA,U,6)
S DATASRC=$P(TMP812,U,3)
S COMMENT=TMP811
S IDT=9999999-$P(EVENTDT,".",1)
S ^TMP("PXF",$J,HFCNAME,IDT,HFNAME,VHFIEN,0)=PNAME_U_EVENTDT_U_SNAME_U_LEVEL_U_OPROV_U_EPROV
S ^TMP("PXF",$J,HFCNAME,IDT,HFNAME,VHFIEN,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
S ^TMP("PXF",$J,HFCNAME,IDT,HFNAME,VHFIEN,"COM")=COMMENT
I TMP220'="" S ^TMP("PXF",$J,HFCNAME,IDT,HFNAME,VHFIEN,"MEASUREMENT")=TMP220
S ^TMP("PXF",$J,HFCNAME,IDT,HFNAME,VHFIEN,"S")=DATASRC
Q 1
;
;====================
HFALL(DFN,BEGDT,ENDDT,OCCLIM) ;Get all health factors for a patient in the
;date range and up to the occurrence limit for each health factor.
N CNT,DATE,HFIEN,VHFIEN
S HFIEN=""
F S HFIEN=$O(^PXRMINDX(9000010.23,"PI",DFN,HFIEN)) Q:(HFIEN="") D
. S CNT=0,DATE=""
. F S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE),-1) Q:(DATE="")!(CNT'<OCCLIM) D
.. S VHFIEN=0
.. F S VHFIEN=$O(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE,VHFIEN)) Q:(VHFIEN="")!(CNT'<OCCLIM) D
... I $$ADDHF(HFIEN,VHFIEN,BEGDT,ENDDT)=1 S CNT=CNT+1
Q
;
;====================
HFCAT(HFCATIEN,DFN,BEGDT,ENDDT,OCCLIM) ;Process a category health factor.
N HFIEN
S HFIEN=""
F S HFIEN=$O(^AUTTHF("AC",HFCATIEN,HFIEN)) Q:HFIEN="" D
. D HFONE(HFIEN,DFN,BEGDT,ENDDT,OCCLIM)
Q
;
;====================
HFONE(HFIEN,DFN,BEGDT,ENDDT,OCCLIM) ;Process a single health factor.
N CNT,DATE,VHFIEN
S CNT=0,DATE=""
F S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE),-1) Q:(DATE="")!(CNT'<OCCLIM) D
. S VHFIEN=0
. F S VHFIEN=$O(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE,VHFIEN)) Q:(VHFIEN="")!(CNT'<OCCLIM) D
.. I $$ADDHF(HFIEN,VHFIEN,BEGDT,ENDDT)=1 S CNT=CNT+1
Q
;
;====================
HFSELECT(DFN,BEGDT,ENDDT,ITEMS,OCCLIM) ;Selected health factors for a patient.
N ETYPE,HFIEN
S HFIEN=""
F S HFIEN=$O(ITEMS(HFIEN)) Q:HFIEN="" D
. S ETYPE=$P(^AUTTHF(HFIEN,0),U,10)
. I ETYPE="C" D HFCAT(HFIEN,DFN,BEGDT,ENDDT,OCCLIM) Q
. I ETYPE="F" D HFONE(HFIEN,DFN,BEGDT,ENDDT,OCCLIM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRHS07 6041 printed Apr 09, 2024@21:32:58 Page 2
PXRHS07 ;ISL/PKR - PCE V HEALTH FACTORS extract routine ;05/26/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13,123,211,217**;Aug 12, 1996;Build 134
+2 ; Extract returns HEALTH FACTORS data
+3 ;Original version by SBW
HF(DFN,BEGDT,ENDDT,OCCLIM,ITEMS) ; Control branching
+1 ;INPUT : DFN - Pointer to PATIENT file (#2)
+2 ; BEGDT - Beginning date/time in internal FileMan format
+3 ; - Defaults to one year prior to today's date
+4 ; ENDDT - Ending date/time in internal FileMan format
+5 ; - Defaults to today's date at 11:59 pm
+6 ; OCCLIM - Maximum number of days for which data is returned
+7 ; for each Health Factors item.
+8 ; If multiple visits on a given day, all data for
+9 ; these visit will be returned.
+10 ; Note: If event date is used, it may appear that too
+11 ; many occurrences are retrieved but it is
+12 ; it is based on visit date not event date.
+13 ; ITEMS - Optional array containing a selected list of
+14 ; HF Categories. If not used will get all categories
+15 ; of health factors.
+16 ;OUTPUT :
+17 ; Data from V HEALTH FACTORS (9000010.23) file
+18 ; ^TMP("PXF,$J,HFC,InvDt,HF,IFN,0) = PRINT NAME or Health Factor [E;.01]
+19 ; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
+20 ; ^ SHORT NAME [E;9999999.64;.04] ^ LEVEL/SEVERITY [E;.04]
+21 ; ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204]
+22 ; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+23 ; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+24 ; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+25 ; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+26 ; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+27 ; ^ HOSP. LOC. ABBREVIATION [E;44;1]
+28 ; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
+29 ; ^TMP("PXF",$J,HFC,InvDt,HF,IFN,"S") = DATA SOURCE [E;81203]
+30 ;
+31 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
+32 ; Subscripts:
+33 ; HFC - Health Factor Category name
+34 ; InvDt - Inverse FileMan date of Event Date and Time or Visit
+35 ; HF - Health Factor name
+36 ; IFN - Internal Record #
+37 ;
+38 if $GET(DFN)']""!'$DATA(^PXRMINDX(9000010.23,"PI",DFN))
QUIT
+39 if +$GET(OCCLIM)'>0
SET OCCLIM=999
+40 if +$GET(BEGDT)'>0
SET BEGDT=DT-10000
+41 if +$GET(ENDDT)'>0
SET ENDDT=DT_".235959"
+42 KILL ^TMP("PXF",$JOB)
+43 IF '$DATA(ITEMS)
DO HFALL(DFN,BEGDT,ENDDT,OCCLIM)
+44 IF $DATA(ITEMS)
DO HFSELECT(DFN,BEGDT,ENDDT,.ITEMS,OCCLIM)
+45 QUIT
+46 ;
+47 ;====================
ADDHF(HFIEN,VHFIEN,BEGDT,ENDDT) ;Check a specific health factor and determine
+1 ;if it should be added to the list. Return 1 if it was added to the
+2 ;list, 0 if it was not.
+3 NEW COMMENT,DATASRC,EPROV,EVENTDT,HFCAT,HFCNAME,HFNAME,HLOC,HLOCABB,IDT
+4 NEW OPROV,LEVEL,PNAME,SNAME,TEMP,TMP0,TMP12,TMP220,TMP811,TMP812,VDATA
+5 SET TEMP=^AUTTHF(HFIEN,0)
+6 ;Is Display on Health Summary YES?
+7 IF $PIECE(TEMP,U,8)'="Y"
QUIT 0
+8 SET TMP0=$GET(^AUPNVHF(VHFIEN,0))
+9 SET TMP12=$GET(^AUPNVHF(VHFIEN,12))
+10 SET VDATA=$$GETVDATA^PXRHS03($PIECE(TMP0,U,3))
+11 SET EVENTDT=$PIECE(TMP12,U,1)
+12 ;If there is no Event Date use the Visit Date.
+13 IF EVENTDT=""
SET EVENTDT=$PIECE(VDATA,U,1)
+14 ;Is it in the date range?
+15 IF (EVENTDT<BEGDT)!(EVENTDT>ENDDT)
QUIT 0
+16 SET HFNAME=$PIECE(TEMP,U,1)
+17 SET SNAME=$PIECE(TEMP,U,4)
+18 SET PNAME=$PIECE($GET(^AUTTHF(HFIEN,200)),U,1)
+19 IF PNAME=""
SET PNAME=HFNAME
+20 SET HFCAT=$PIECE(TEMP,U,3)
+21 IF HFCAT=""
QUIT 0
+22 SET HFCNAME=$PIECE($GET(^AUTTHF(HFCAT,200)),U,1)
+23 IF HFCNAME=""
SET HFCNAME=$PIECE(^AUTTHF(HFCAT,0),U,1)
+24 SET TMP220=$GET(^AUPNVHF(VHFIEN,220))
+25 IF TMP220'=""
SET TMP220=TMP220_U_$PIECE(^AUTTHF(HFIEN,220),U,6)
+26 SET TMP811=$GET(^AUPNVHF(VHFIEN,811))
+27 SET TMP812=$GET(^AUPNVHF(VHFIEN,812))
+28 SET LEVEL=$$EXTERNAL^DILFD(9000010.23,.04,"",$PIECE(TMP0,U,4))
+29 SET OPROV=$$GET1^DIQ(9000010.23,VHFIEN_",",1202)
+30 SET EPROV=$$GET1^DIQ(9000010.23,VHFIEN_",",1204)
+31 SET HLOC=$PIECE(VDATA,U,5)
+32 SET HLOCABB=$PIECE(VDATA,U,6)
+33 SET DATASRC=$PIECE(TMP812,U,3)
+34 SET COMMENT=TMP811
+35 SET IDT=9999999-$PIECE(EVENTDT,".",1)
+36 SET ^TMP("PXF",$JOB,HFCNAME,IDT,HFNAME,VHFIEN,0)=PNAME_U_EVENTDT_U_SNAME_U_LEVEL_U_OPROV_U_EPROV
+37 SET ^TMP("PXF",$JOB,HFCNAME,IDT,HFNAME,VHFIEN,1)=HLOC_U_HLOCABB_U_$PIECE(VDATA,U,2)_U_$PIECE(VDATA,U,4)
+38 SET ^TMP("PXF",$JOB,HFCNAME,IDT,HFNAME,VHFIEN,"COM")=COMMENT
+39 IF TMP220'=""
SET ^TMP("PXF",$JOB,HFCNAME,IDT,HFNAME,VHFIEN,"MEASUREMENT")=TMP220
+40 SET ^TMP("PXF",$JOB,HFCNAME,IDT,HFNAME,VHFIEN,"S")=DATASRC
+41 QUIT 1
+42 ;
+43 ;====================
HFALL(DFN,BEGDT,ENDDT,OCCLIM) ;Get all health factors for a patient in the
+1 ;date range and up to the occurrence limit for each health factor.
+2 NEW CNT,DATE,HFIEN,VHFIEN
+3 SET HFIEN=""
+4 FOR
SET HFIEN=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,HFIEN))
if (HFIEN="")
QUIT
Begin DoDot:1
+5 SET CNT=0
SET DATE=""
+6 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE),-1)
if (DATE="")!(CNT'<OCCLIM)
QUIT
Begin DoDot:2
+7 SET VHFIEN=0
+8 FOR
SET VHFIEN=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE,VHFIEN))
if (VHFIEN="")!(CNT'<OCCLIM)
QUIT
Begin DoDot:3
+9 IF $$ADDHF(HFIEN,VHFIEN,BEGDT,ENDDT)=1
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
+12 ;====================
HFCAT(HFCATIEN,DFN,BEGDT,ENDDT,OCCLIM) ;Process a category health factor.
+1 NEW HFIEN
+2 SET HFIEN=""
+3 FOR
SET HFIEN=$ORDER(^AUTTHF("AC",HFCATIEN,HFIEN))
if HFIEN=""
QUIT
Begin DoDot:1
+4 DO HFONE(HFIEN,DFN,BEGDT,ENDDT,OCCLIM)
End DoDot:1
+5 QUIT
+6 ;
+7 ;====================
HFONE(HFIEN,DFN,BEGDT,ENDDT,OCCLIM) ;Process a single health factor.
+1 NEW CNT,DATE,VHFIEN
+2 SET CNT=0
SET DATE=""
+3 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE),-1)
if (DATE="")!(CNT'<OCCLIM)
QUIT
Begin DoDot:1
+4 SET VHFIEN=0
+5 FOR
SET VHFIEN=$ORDER(^PXRMINDX(9000010.23,"PI",DFN,HFIEN,DATE,VHFIEN))
if (VHFIEN="")!(CNT'<OCCLIM)
QUIT
Begin DoDot:2
+6 IF $$ADDHF(HFIEN,VHFIEN,BEGDT,ENDDT)=1
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
+9 ;====================
HFSELECT(DFN,BEGDT,ENDDT,ITEMS,OCCLIM) ;Selected health factors for a patient.
+1 NEW ETYPE,HFIEN
+2 SET HFIEN=""
+3 FOR
SET HFIEN=$ORDER(ITEMS(HFIEN))
if HFIEN=""
QUIT
Begin DoDot:1
+4 SET ETYPE=$PIECE(^AUTTHF(HFIEN,0),U,10)
+5 IF ETYPE="C"
DO HFCAT(HFIEN,DFN,BEGDT,ENDDT,OCCLIM)
QUIT
+6 IF ETYPE="F"
DO HFONE(HFIEN,DFN,BEGDT,ENDDT,OCCLIM)
End DoDot:1
+7 QUIT
+8 ;
