source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRHS07.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PXRHS07 ;ISL/SBW - PCE V HEALTH FACTORS extract routine ;09/9/03
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13,123**;Aug 12, 1996
3 ; Extract returns HEALTH FACTORS data
4HF(DFN,ENDDT,BEGDT,OCCLIM,ITEMS) ; Control branching
5 ;INPUT : DFN - Pointer to PATIENT file (#2)
6 ; ENDDT - Ending date/time in internal FileMan format
7 ; - Defaults to today's date at 11:59 pm
8 ; BEGDT - Beginning date/time in internal FileMan format
9 ; - Defaults to one year prior to today's date
10 ; OCCLIM - Maximum number of days for which data is returned
11 ; for each Health Factors item.
12 ; If multiple visits on a given day, all data for
13 ; these visit will be returned.
14 ; Note: If event date is used, it may appear that too
15 ; many occurrences are retrieved but it is
16 ; it is based on visit date not event date.
17 ; ITEMS - Optional array containing a selected list of
18 ; HF Categories. If not used will get all catergories
19 ; of health factors.
20 ;OUTPUT :
21 ; Data from V HEALTH FACTORS (9000010.23) file
22 ; ^TMP("PXF,$J,HFC,HF,InvDt,IFN,0) = Health Factor [E;.01]
23 ; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
24 ; ^ SHORT NAME [E;9999999.64;.04] ^ LEVEL/SEVERITY [E;.04]
25 ; ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204]
26 ; ^TMP("PXF",$J,HFC,HF,InvDt,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,HF,InvDt,IFN,"S") = DATA SOURCE [E;80102]
30 ;
31 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
32 ; Subscripts:
33 ; HFC - Health Factor Category name
34 ; HF - Health Factor name
35 ; InvDt - Inverse FileMan date of DATE OF event or visit
36 ; IFN - Internal Record #
37 ;
38 Q:$G(DFN)']""!'$D(^AUPNVHF("AA",DFN))
39 N PXHFC,IBEGDT,IENDDT,ITEM
40 N HFIEN,CATIEN,CATNAME
41 S:+$G(OCCLIM)'>0 OCCLIM=999
42 S:+$G(BEGDT)'>0 BEGDT=DT-10000
43 S:+$G(ENDDT)'>0 ENDDT=DT_".235959"
44 ; Chg regular dt/time to inverted dt/time
45 S IBEGDT=9999999-ENDDT,IENDDT=9999999-BEGDT
46 K ^TMP("PXF",$J)
47 ;I $D(ITEMS)'>0 D Q
48 ;. S PXHFC=0
49 ;. F S PXHFC=$O(^AUTTHF("AD","C",PXHFC)) Q:PXHFC'>0 D GETVHF(PXHFC,OCCLIM)
50 ;I $D(ITEMS)>0 D
51 ;. S PXHFC=0
52 ;. F S PXHFC=$O(ITEMS(PXHFC)) Q:PXHFC'>0 D GETVHF(PXHFC,OCCLIM)
53 ;Q
54 ;
55 ;If no ITEMS are defined build a list of all health factors for the
56 ;patient.
57 I $D(ITEMS)'>0 D Q
58 . S PXHFC=0
59 . F S PXHFC=$O(^AUTTHF("AD","C",PXHFC)) Q:PXHFC'>0 D GETVHF(PXHFC,OCCLIM)
60 ;. . S CATIEN=$P(^AUTTHF(PXHFC,0),U,3)
61 ;.. S CATNAME=$P(^AUTTHF(CATIEN,0),U,1)
62 ;.. D GETVHF(CATNAME,PXHFC,OCCLIM)
63 ;
64 ;Loop through the items array to find hf associate with category and
65 ;individual health factor placed finding into temp array & sort by alpha
66 S ITEM=""
67 F S ITEM=$O(ITEMS(ITEM)) Q:ITEM="" D
68 .;If a category get all health factors in category.
69 . I $P(^AUTTHF(ITEM,0),U,10)="C" D Q
70 . . ;S CATNAME=$P(^AUTTHF(ITEM,0),U)
71 . . ;S HFIEN=""
72 . . ;F S HFIEN=$O(^AUTTHF("AC",ITEM,HFIEN)) Q:HFIEN=""
73 . . D GETVHF(ITEM,OCCLIM)
74 .;If a factor just process it.
75 . I $P(^AUTTHF(ITEM,0),U,10)="F" D
76 . . S CATIEN=$P(^AUTTHF(ITEM,0),U,3)
77 . . S CATNAME=$P(^AUTTHF(CATIEN,0),U,1)
78 . . D PHF(ITEM,OCCLIM)
79 Q
80GETVHF(PXHFC,MAX) ;Get Health Factors within a category
81 N PXHF
82 S PXHF=0
83 F S PXHF=$O(^AUTTHF("AC",PXHFC,PXHF)) Q:PXHF'>0 D PHF(PXHF,MAX)
84 Q
85PHF(PXHF,MAX) ; Get Health Factors within a category
86 N PXIVD,PXIFN,CNT,PDT
87 ;S PXHF=0
88 ;F S PXHF=$O(^AUTTHF("AC",PXHFC,PXHF)) Q:PXHF'>0 D
89 S CNT=0,PXIVD=0
90 F S PXIVD=$O(^AUPNVHF("AA",DFN,PXHF,PXIVD)) Q:PXIVD'>0!(CNT'<OCCLIM) D
91 . S PXIFN=0
92 . F S PXIFN=$O(^AUPNVHF("AA",DFN,PXHF,PXIVD,PXIFN)) Q:PXIFN'>0 D
93 . . N DIC,DIQ,DR,DA,REC,VDATA,HFC,HF,EXDT,LEVEL,SNAME,COMMENT
94 . . N OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT
95 . . S DIC=9000010.23,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
96 . . S DR=".01;.03;.04;1201;1202;1204;80102;81101"
97 . . D EN^DIQ1
98 . . Q:'$D(REC)
99 . . S VDATA=$$GETVDATA^PXRHS03(+REC(9000010.23,DA,.03,"I"))
100 . . S HF=REC(9000010.23,DA,.01,"E")
101 . . S EXDT=REC(9000010.23,DA,1201,"I")
102 . . S:EXDT']"" EXDT=$P(VDATA,U)
103 . . S IDT=9999999-EXDT
104 . . I IDT<IBEGDT!(IDT>IENDDT) Q ;Only get data within date range
105 . . I CNT'<OCCLIM Q
106 . . D GETHF(REC(9000010.23,DA,.01,"I"),.HFC,.SNAME)
107 . . S LEVEL=REC(9000010.23,DA,.04,"E")
108 . . S OPROV=REC(9000010.23,DA,1202,"E")
109 . . S EPROV=REC(9000010.23,DA,1204,"E")
110 . . S HLOC=$P(VDATA,U,5)
111 . . S HLOCABB=$P(VDATA,U,6)
112 . . S SOURCE=REC(9000010.23,DA,80102,"E")
113 . . S COMMENT=REC(9000010.23,DA,81101,"E")
114 . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,0)=HF_U_EXDT_U_SNAME_U_LEVEL_U_OPROV_U_EPROV
115 . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
116 . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,"S")=SOURCE
117 . . S ^TMP("PXF",$J,HFC,HF,IDT,DA,"COM")=COMMENT
118 . . ;Counter by health factor and date, not by visit. There may be
119 . . ;multiple health factors for any given day
120 . . I PXIVD'=$G(PDT) S PDT=PXIVD
121 . . S CNT=CNT+1
122 Q
123GETHF(DA,HFC,SNAME) ;
124 N DIC,DIQ,DR,REC
125 S DIC=9999999.64,DIQ="REC(",DIQ(0)="E",DR=".01;.03;.04"
126 D EN^DIQ1
127 I '$D(REC) S (HFC,SNAME)="" Q
128 S HFC=REC(9999999.64,DA,.03,"E")
129 S SNAME=REC(9999999.64,DA,.04,"E")
130 Q
Note: See TracBrowser for help on using the repository browser.