source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRHS04.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PXRHS04 ; SLC/SBW - PCE Visit Skin Test Data Extract ;11/25/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13**;Aug 12, 1996
3SKIN(DFN) ; Control branching
4 ;INPUT : DFN - Pointer to PATIENT file (#2)
5 ;OUTPUT :
6 ; Data from V SKIN TEST (9000010.12) file
7 ; ^TMP("PXS,$J,SKIN,InvDt,IFN,0) = SKIN TEST [E;.01]
8 ; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
9 ; ^ RESULTS CODE [I;.04] ^ RESULTS [E;.04] ^ READING [E;.05]
10 ; ^ DATE READ [I;.06] ^ ORDERING PROVIDER [E;1202]
11 ; ^ ENCOUNTER PROVIDER [E;1204]
12 ; ^TMP("PXS",$J,SKIN,InvDt,IFN,1) = ^ HOSPITAL LOCATION [E;9000010;.22]
13 ; ^ HOSP. LOC. ABBREVIATION [E;44;1]
14 ; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
15 ; ^TMP("PXS",$J,SKIN,InvDt,IFN,"S") = DATA SOURCE [E;80102]
16 ;
17 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
18 ; Subscripts:
19 ; SKIN - Skin Test name
20 ; InvDt - Inverse FileMan date of DATE OF event or visit
21 ; IFN - Internal Record #
22 ;
23 Q:$G(DFN)']""!'$D(^AUPNVSK("AA",DFN))
24 N PXSK,PXIVD,PXIFN,IHSDATE
25 S IHSDATE=9999999-$$HSDATE^PXRHS01
26 K ^TMP("PXS",$J)
27 S PXSK=""
28 F S PXSK=$O(^AUPNVSK("AA",DFN,PXSK)) Q:PXSK="" D
29 . S PXIVD=0
30 . F S PXIVD=$O(^AUPNVSK("AA",DFN,PXSK,PXIVD)) Q:PXIVD'>0 Q:PXIVD>IHSDATE D
31 . . S PXIFN=0
32 . . F S PXIFN=$O(^AUPNVSK("AA",DFN,PXSK,PXIVD,PXIFN)) Q:PXIFN'>0 D
33 . . . N DIC,DIQ,DR,DA,REC,VDATA,SKIN,SKDT,RESULTC,RESULT,READING,RDT
34 . . . N OPROV,EPROV,HLOC,HLOCABB,SOURCE,IDT,COMMENT
35 . . . S DIC=9000010.12,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
36 . . . S DR=".01;.03;.04;.05;.06;1201;1202;1204;80102;81101"
37 . . . D EN^DIQ1
38 . . . Q:'$D(REC)
39 . . . S VDATA=$$GETVDATA^PXRHS03(+REC(9000010.12,DA,.03,"I"))
40 . . . S SKIN=REC(9000010.12,DA,.01,"E")
41 . . . S SKDT=REC(9000010.12,DA,1201,"I")
42 . . . S:SKDT']"" SKDT=$P(VDATA,U)
43 . . . S IDT=9999999-SKDT
44 . . . S RESULTC=REC(9000010.12,DA,.04,"I")
45 . . . S RESULT=REC(9000010.12,DA,.04,"E")
46 . . . S READING=REC(9000010.12,DA,.05,"E")
47 . . . S RDT=REC(9000010.12,DA,.06,"I")
48 . . . S OPROV=REC(9000010.12,DA,1202,"E")
49 . . . S EPROV=REC(9000010.12,DA,1204,"E")
50 . . . S HLOC=$P(VDATA,U,5)
51 . . . S HLOCABB=$P(VDATA,U,6)
52 . . . S SOURCE=REC(9000010.12,DA,80102,"E")
53 . . . S COMMENT=REC(9000010.12,DA,81101,"E")
54 . . . S ^TMP("PXS",$J,SKIN,IDT,DA,0)=SKIN_U_SKDT_U_RESULTC_U_RESULT_U_READING_U_RDT_U_OPROV_U_EPROV
55 . . . S ^TMP("PXS",$J,SKIN,IDT,DA,1)=HLOC_U_HLOCABB_U_$P(VDATA,U,2)_U_$P(VDATA,U,4)
56 . . . S ^TMP("PXS",$J,SKIN,IDT,DA,"S")=SOURCE
57 . . . S ^TMP("PXS",$J,SKIN,IDT,DA,"COM")=COMMENT
58 Q
Note: See TracBrowser for help on using the repository browser.