PXRHS07 ;ISL/SBW - PCE V HEALTH FACTORS extract routine ;12/10/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**13**;Aug 12, 1996
; Extract returns HEALTH FACTORS data
HF(DFN,ENDDT,BEGDT,OCCLIM,ITEMS) ; 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 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 catergories
; of health factors.
;OUTPUT :
; Data from V HEALTH FACTORS (9000010.23) file
; ^TMP("PXF,$J,HFC,HF,InvDt,IFN,0) = 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,HF,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("PXF",$J,HFC,HF,InvDt,IFN,"S") = DATA SOURCE [E;80102]
;
; [] = [I(nternal)/E(xternal); Optional file #; Record #]
; Subscripts:
; HFC - Health Factor Category name
; HF - Health Factor name
; InvDt - Inverse FileMan date of DATE OF event or visit
; IFN - Internal Record #
;
Q:$G(DFN)']""!'$D(^AUPNVHF("AA",DFN))
N PXHFC,IBEGDT,IENDDT
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("PXF",$J)
I $D(ITEMS)'>0 D Q
. S PXHFC=0
. F S PXHFC=$O(^AUTTHF("AD","C",PXHFC)) Q:PXHFC'>0 D GETVHF(PXHFC,OCCLIM)
I $D(ITEMS)>0 D
. S PXHFC=0
. F S PXHFC=$O(ITEMS(PXHFC)) Q:PXHFC'>0 D GETVHF(PXHFC,OCCLIM)
Q
GETVHF(PXHFC,MAX) ; Get Health Factors within a category
N PXHF,PXIVD,PXIFN,CNT,PDT
S PXHF=0
F S PXHF=$O(^AUTTHF("AC",PXHFC,PXHF)) Q:PXHF'>0 D
. S CNT=0,PXIVD=0
. F S PXIVD=$O(^AUPNVHF("AA",DFN,PXHF,PXIVD)) Q:PXIVD'>0 D Q:CNT'<OCCLIM
. . S PXIFN=0
. . F S PXIFN=$O(^AUPNVHF("AA",DFN,PXHF,PXIVD,PXIFN)) Q:PXIFN'>0 D
. . . N DIC,DIQ,DR,DA,REC,VDATA,HFC,HF,EXDT,LEVEL,SNAME,COMMENT
. . . N OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT
. . . S DIC=9000010.23,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
. . . S DR=".01;.03;.04;1201;1202;1204;80102;81101"
. . . D EN^DIQ1
. . . Q:'$D(REC)
. . . S VDATA=$$GETVDATA^PXRHS03(+REC(9000010.23,DA,.03,"I"))
. . . S HF=REC(9000010.23,DA,.01,"E")
. . . S EXDT=REC(9000010.23,DA,1201,"I")
. . . S:EXDT']"" EXDT=$P(VDATA,U)
. . . S IDT=9999999-EXDT
. . . I IDT<IBEGDT!(IDT>IENDDT) Q ;Only get data within date range
. . . D GETHF(REC(9000010.23,DA,.01,"I"),.HFC,.SNAME)
. . . S LEVEL=REC(9000010.23,DA,.04,"E")
. . . S OPROV=REC(9000010.23,DA,1202,"E")
. . . S EPROV=REC(9000010.23,DA,1204,"E")
. . . S HLOC=$P(VDATA,U,5)
. . . S HLOCABB=$P(VDATA,U,6)
. . . S SOURCE=REC(9000010.23,DA,80102,"E")
. . . S COMMENT=REC(9000010.23,DA,81101,"E")
. . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,0)=HF_U_EXDT_U_SNAME_U_LEVEL_U_OPROV_U_EPROV
. . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
. . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,"S")=SOURCE
. . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,"COM")=COMMENT
. . . ;Counter by health factor and date, not by visit. There may be
. . . ;multiple health factors for any given day
. . . I PXIVD'=$G(PDT) S CNT=CNT+1,PDT=PXIVD
Q
GETHF(DA,HFC,SNAME) ;
N DIC,DIQ,DR,REC
S DIC=9999999.64,DIQ="REC(",DIQ(0)="E",DR=".01;.03;.04"
D EN^DIQ1
I '$D(REC) S (HFC,SNAME)="" Q
S HFC=REC(9999999.64,DA,.03,"E")
S SNAME=REC(9999999.64,DA,.04,"E")
Q
PXRHS07 ;ISL/SBW - PCE V HEALTH FACTORS extract routine ;12/10/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13**;Aug 12, 1996
+2 ; Extract returns HEALTH FACTORS data
HF(DFN,ENDDT,BEGDT,OCCLIM,ITEMS) ; 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 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 catergories
+15 ; of health factors.
+16 ;OUTPUT :
+17 ; Data from V HEALTH FACTORS (9000010.23) file
+18 ; ^TMP("PXF,$J,HFC,HF,InvDt,IFN,0) = 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,HF,InvDt,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+23 ; ^ HOSP. LOC. ABBREVIATION [E;44;1]
+24 ; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
+25 ; ^TMP("PXF",$J,HFC,HF,InvDt,IFN,"S") = DATA SOURCE [E;80102]
+26 ;
+27 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
+28 ; Subscripts:
+29 ; HFC - Health Factor Category name
+30 ; HF - Health Factor name
+31 ; InvDt - Inverse FileMan date of DATE OF event or visit
+32 ; IFN - Internal Record #
+33 ;
+34 IF $GET(DFN)']""!'$DATA(^AUPNVHF("AA",DFN))
QUIT
+35 NEW PXHFC,IBEGDT,IENDDT
+36 IF +$GET(OCCLIM)'>0
SET OCCLIM=999
+37 IF +$GET(BEGDT)'>0
SET BEGDT=DT-10000
+38 IF +$GET(ENDDT)'>0
SET ENDDT=DT_".235959"
+39 ; Chg regular dt/time to inverted dt/time
+40 SET IBEGDT=9999999-ENDDT
SET IENDDT=9999999-BEGDT
+41 KILL ^TMP("PXF",$JOB)
+42 IF $DATA(ITEMS)'>0
Begin DoDot:1
+43 SET PXHFC=0
+44 FOR
SET PXHFC=$ORDER(^AUTTHF("AD","C",PXHFC))
IF PXHFC'>0
QUIT
DO GETVHF(PXHFC,OCCLIM)
End DoDot:1
QUIT
+45 IF $DATA(ITEMS)>0
Begin DoDot:1
+46 SET PXHFC=0
+47 FOR
SET PXHFC=$ORDER(ITEMS(PXHFC))
IF PXHFC'>0
QUIT
DO GETVHF(PXHFC,OCCLIM)
End DoDot:1
+48 QUIT
GETVHF(PXHFC,MAX) ; Get Health Factors within a category
+1 NEW PXHF,PXIVD,PXIFN,CNT,PDT
+2 SET PXHF=0
+3 FOR
SET PXHF=$ORDER(^AUTTHF("AC",PXHFC,PXHF))
IF PXHF'>0
QUIT
Begin DoDot:1
+4 SET CNT=0
SET PXIVD=0
+5 FOR
SET PXIVD=$ORDER(^AUPNVHF("AA",DFN,PXHF,PXIVD))
IF PXIVD'>0
QUIT
Begin DoDot:2
+6 SET PXIFN=0
+7 FOR
SET PXIFN=$ORDER(^AUPNVHF("AA",DFN,PXHF,PXIVD,PXIFN))
IF PXIFN'>0
QUIT
Begin DoDot:3
+8 NEW DIC,DIQ,DR,DA,REC,VDATA,HFC,HF,EXDT,LEVEL,SNAME,COMMENT
+9 NEW OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT
+10 SET DIC=9000010.23
SET DA=PXIFN
SET DIQ="REC("
SET DIQ(0)="IE"
+11 SET DR=".01;.03;.04;1201;1202;1204;80102;81101"
+12 DO EN^DIQ1
+13 IF '$DATA(REC)
QUIT
+14 SET VDATA=$$GETVDATA^PXRHS03(+REC(9000010.23,DA,.03,"I"))
+15 SET HF=REC(9000010.23,DA,.01,"E")
+16 SET EXDT=REC(9000010.23,DA,1201,"I")
+17 IF EXDT']""
SET EXDT=$PIECE(VDATA,U)
+18 SET IDT=9999999-EXDT
+19 ;Only get data within date range
IF IDT<IBEGDT!(IDT>IENDDT)
QUIT
+20 DO GETHF(REC(9000010.23,DA,.01,"I"),.HFC,.SNAME)
+21 SET LEVEL=REC(9000010.23,DA,.04,"E")
+22 SET OPROV=REC(9000010.23,DA,1202,"E")
+23 SET EPROV=REC(9000010.23,DA,1204,"E")
+24 SET HLOC=$PIECE(VDATA,U,5)
+25 SET HLOCABB=$PIECE(VDATA,U,6)
+26 SET SOURCE=REC(9000010.23,DA,80102,"E")
+27 SET COMMENT=REC(9000010.23,DA,81101,"E")
+28 SET ^TMP("PXF",$JOB,HFC,HF,IDT,DA,0)=HF_U_EXDT_U_SNAME_U_LEVEL_U_OPROV_U_EPROV
+29 SET ^TMP("PXF",$JOB,HFC,HF,IDT,DA,1)=HLOC_U_HLOCABB_U_$PIECE(VDATA,U,2)_U_$PIECE(VDATA,U,4)
+30 SET ^TMP("PXF",$JOB,HFC,HF,IDT,DA,"S")=SOURCE
+31 SET ^TMP("PXF",$JOB,HFC,HF,IDT,DA,"COM")=COMMENT
+32 ;Counter by health factor and date, not by visit. There may be
+33 ;multiple health factors for any given day
+34 IF PXIVD'=$GET(PDT)
SET CNT=CNT+1
SET PDT=PXIVD
End DoDot:3
End DoDot:2
IF CNT'<OCCLIM
QUIT
End DoDot:1
+35 QUIT
GETHF(DA,HFC,SNAME) ;
+1 NEW DIC,DIQ,DR,REC
+2 SET DIC=9999999.64
SET DIQ="REC("
SET DIQ(0)="E"
SET DR=".01;.03;.04"
+3 DO EN^DIQ1
+4 IF '$DATA(REC)
SET (HFC,SNAME)=""
QUIT
+5 SET HFC=REC(9999999.64,DA,.03,"E")
+6 SET SNAME=REC(9999999.64,DA,.04,"E")
+7 QUIT
