source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVLABAD1.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1WVLABAD1 ;HCIOFO/FT-LAB/WOMEN'S HEALTH LINK (cont.) ;4/6/99 12:33
2 ;;1.0;WOMEN'S HEALTH;**6**;Sep 30, 1998
3 ;
4FIND ; Try to associate an incoming lab test entry with an existing WH
5 ; procedure that has no link to a lab accession # to avoid duplicates.
6 ; Called from WVLABADD.
7 ; Input variables needed:
8 ; DFN - patient ien
9 ; WVPROC - ien of WV Procedure Type (790.2)
10 ; WVDATE - date portion of date of lab test
11 ;
12 ; First, loop through Date of Procedure x-ref
13 N WVDTECHK,WVDATE0,WVFLAG,WVIEN,WVLOOP,WVNODE0,WVNODE2
14 S WVDATE0=$P(WVDATE,".",1)
15 S WVDTECHK=WVDATE0_".999999",WVFLAG=0,WVLOOP=WVDATE0-.000001
16 F S WVLOOP=$O(^WV(790.1,"D",WVLOOP)) Q:'WVLOOP!(WVLOOP>WVDTECHK)!(WVFLAG) S WVIEN=0 F S WVIEN=$O(^WV(790.1,"D",WVLOOP,WVIEN)) Q:'WVIEN!(WVFLAG) D
17 .S WVNODE0=$G(^WV(790.1,WVIEN,0)) Q:WVNODE0=""
18 .S WVNODE2=$G(^WV(790.1,WVIEN,2))
19 .Q:$P(WVNODE2,U,17)]"" ;already has a lab test link
20 .Q:$P(WVNODE0,U,2)'=DFN ;not the same patient
21 .Q:$P(WVNODE0,U,4)'=WVPROC ;not the same procedure
22 .D LINK
23 .S WVFLAG=1 ;flag that link is made to an existing record, so quit loop
24 .Q
25 Q
26LINK ; Update values in existing entry including lab accession# link.
27 ; Input variables needed:
28 ; WVNODE - zero node of a File 790.08 entry.
29 ; WVNODE0 - zero node of a File 790.1 entry
30 ; WVIEN - File 790.1 ien
31 Q:$G(WVNODE)="" Q:'$G(WVIEN)
32 N DIE,DA,DR
33 S DIE="^WV(790.1,",DA=WVIEN
34 ; fill in missing data where possible.
35 S DR="2.17////"_$P(WVNODE,U,1) ;lab accession#
36 S DR=DR_";2.18////"_$P(WVNODE,U,36) ;lab data file (#63) ien
37 S DR=DR_";2.19////"_$P(WVNODE,U,37) ;lab inverse date/time
38 S DR=DR_";2.2////"_$P(WVNODE,U,38) ;lab subscript (CY or SP)
39 I $P(WVNODE0,U,7)="",$P(WVNODE,U,7)]"" S DR=DR_";.07////"_$P(WVNODE,U,7) ;provider
40 I $P(WVNODE0,U,10)="",$G(DUZ(2))]"" S DR=DR_";.1////"_$G(DUZ(2)) ;facility
41 I $P(WVNODE0,U,11)="",$P(WVNODE,U,11)]"" S DR=DR_";.11////"_$P(WVNODE,U,11) ;location
42 D ^DIE
43 Q
Note: See TracBrowser for help on using the repository browser.