Routine: PXRHS07

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)

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

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")

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

PXRHS07.m