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

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

initial load of FOIAVistA 6/30/08 version
File size: 2.9 KB
Line 
1PXRHS05 ;ISL/SBW - PCE V EXAM extract routine ;12/10/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13**;Aug 12, 1996
3 ; Extract returns EXAM data
4EXAM(DFN,ENDDT,BEGDT,OCCLIM) ; 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 # of each type of exam returned
11 ;OUTPUT :
12 ; Data from V EXAM (9000010.13) file
13 ; ^TMP("PXE,$J,EXAM,InvDt,IFN,0) = EXAM [E;.01]
14 ; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
15 ; ^ RESULTS CODE [I;.04] ^ RESULTS [E;.04]
16 ; ^ ORDERING PROVIDER [E;1202] ^ ENCOUNTER PROVIDER [E;1204] ^
17 ; ^TMP("PXE",$J,EXAM,InvDt,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
18 ; ^ HOSP. LOC. ABBREVIATION [E;44;1]
19 ; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
20 ; ^TMP("PXE",$J,EXAM,InvDt,IFN,"S") = DATA SOURCE [E;80102]
21 ;
22 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
23 ; Subscripts:
24 ; EXAM - EXAM name
25 ; InvDt - Inverse FileMan date of DATE OF event or visit
26 ; IFN - Internal Record #
27 ;
28 Q:$G(DFN)']""!'$D(^AUPNVXAM("AA",DFN))
29 N PXEX,PXIVD,PXIFN,CNT,IBEGDT,IENDDT
30 S:+$G(OCCLIM)'>0 OCCLIM=999
31 S:+$G(BEGDT)'>0 BEGDT=DT-10000
32 S:+$G(ENDDT)'>0 ENDDT=DT_".235959"
33 ; Chg regular dt/time to inverted dt/time
34 S IBEGDT=9999999-ENDDT,IENDDT=9999999-BEGDT
35 K ^TMP("PXE",$J)
36 S PXEX=""
37 F S PXEX=$O(^AUPNVXAM("AA",DFN,PXEX)) Q:PXEX="" D
38 . S PXIVD=IBEGDT,CNT=0
39 . F S PXIVD=$O(^AUPNVXAM("AA",DFN,PXEX,PXIVD)) Q:PXIVD'>0!(PXIVD>IENDDT) D Q:CNT'<OCCLIM
40 . . S PXIFN=0
41 . . F S PXIFN=$O(^AUPNVXAM("AA",DFN,PXEX,PXIVD,PXIFN)) Q:PXIFN'>0 D Q:CNT'<OCCLIM
42 . . . N DIC,DIQ,DR,DA,REC,VDATA,EXAM,EXDT,RESULTC,RESULT,COMMENT
43 . . . N OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT
44 . . . S DIC=9000010.13,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
45 . . . S DR=".01;.03;.04;1201;1202;1204;80102;81101"
46 . . . D EN^DIQ1
47 . . . Q:'$D(REC)
48 . . . S VDATA=$$GETVDATA^PXRHS03(+REC(9000010.13,DA,.03,"I"))
49 . . . S EXAM=REC(9000010.13,DA,.01,"E")
50 . . . S EXDT=REC(9000010.13,DA,1201,"I")
51 . . . S:EXDT']"" EXDT=$P(VDATA,U)
52 . . . S IDT=9999999-EXDT
53 . . . I IDT<IBEGDT!(IDT>IENDDT) Q ;Only get data within date range
54 . . . S RESULTC=REC(9000010.13,DA,.04,"I")
55 . . . S RESULT=REC(9000010.13,DA,.04,"E")
56 . . . S OPROV=REC(9000010.13,DA,1202,"E")
57 . . . S EPROV=REC(9000010.13,DA,1204,"E")
58 . . . S HLOC=$P(VDATA,U,5)
59 . . . S HLOCABB=$P(VDATA,U,6)
60 . . . S SOURCE=REC(9000010.13,DA,80102,"E")
61 . . . S COMMENT=REC(9000010.13,DA,81101,"E")
62 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,0)=EXAM_U_EXDT_U_RESULTC_U_RESULT_U_OPROV_U_EPROV
63 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
64 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,"S")=SOURCE
65 . . . S ^TMP("PXE",$J,EXAM,IDT,DA,"COM")=COMMENT
66 . . . S CNT=CNT+1
67 Q
Note: See TracBrowser for help on using the repository browser.