source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVRALIN1.m@ 1245

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1WVRALIN1 ;HCIOFO/FT-RAD/NM-WOMEN'S HEALTH LINK (cont.) ;2/18/00 10:58
2 ;;1.0;WOMEN'S HEALTH;**5,10**;Sep 30, 1998
3 ;
4FIND ; Try to associate an incoming RAD/NM entry with an existing WH
5 ; procedure that has no link to RAD/NM entry.
6 ; Called from WVRALINK.
7 ; Input variables needed:
8 ; DFN - patient ien
9 ; WVPROC - ien of WV Procedure Type (790.2)
10 ; WVDATE - date portion of date of rad/nm procedure
11 ;
12 ; First, loop through Date of Procedure x-ref
13 N WVDTECHK,WVFLAG,WVIEN,WVLOOP,WVNODE
14 S WVDTECHK=WVDATE_".999999",WVFLAG=0,WVLOOP=WVDATE-.000001
15 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
16 .S WVNODE=$G(^WV(790.1,WVIEN,0)) Q:WVNODE=""
17 .Q:$P(WVNODE,U,15)]"" ;already has a rad/nm link
18 .Q:$P(WVNODE,U,2)'=DFN ;not the same patient
19 .Q:$P(WVNODE,U,4)'=WVPROC ;not the same procedure
20 .D LINK
21 .S WVFLAG=1 ;flag that link is made to an existing record, so quit loop
22 .Q
23 Q
24LINK ; Update values in existing entry including day-case # link.
25 ; Input variables needed:
26 ; WVNODE - zero node of a File 790.1 entry.
27 ; WVIEN - File 790.1 ien
28 Q:$G(WVNODE)="" Q:'$G(WVIEN)
29 N DIE,DA,DR
30 S DIE="^WV(790.1,",DA=WVIEN
31 ; fill in missing data where possible.
32 S DR=".15////"_WVCASE ;radiology mam case# (i.e., link to RAD/NM entry)
33 I $P(WVNODE,U,5)="",$G(WVBWDX)]"" S DR=DR_";.05////"_WVBWDX ;result/dx
34 I $P(WVNODE,U,7)="",$G(WVPROV)]"" S DR=DR_";.07////"_WVPROV ;provider
35 I $P(WVNODE,U,9)="",$G(WVMOD)]"" S DR=DR_";.09////"_WVMOD ;modifier
36 I $P(WVNODE,U,10)="",$G(DUZ(2))]"" S DR=DR_";.1////"_DUZ(2) ;facility
37 I $P(WVNODE,U,11)="",$G(WVLOC)]"" S DR=DR_";.11////"_WVLOC ;location
38 I $P(WVNODE,U,35)="",$G(WVCREDIT)]"" S DR=DR_";.35////"_WVCREDIT ;rad/nm credit method
39 D ^DIE
40 Q
41VNVEC() ; Veteran/Non-Veteran/Eligibility Code check
42 ; DFN must be defined
43 ; Returns 1 - veteran
44 ; include all non-vets flag set to YES
45 ; non-vet patient's eligibility code is on list to track
46 N WVALL,WVLOOP,X,Y
47 I $E($$VET^WVUTL1A(DFN))="Y" Q 1 ;veteran
48 S WVALL=$P($G(^WV(790.02,DUZ(2),0)),U,25) ;include all non-vets
49 I WVALL=1!(WVALL="") Q 1 ;1=YES
50 S WVLOOP=+$$ELIG^WVUTL9(DFN) ;internal^external elig code
51 I 'WVLOOP Q 0 ;no eligibility code
52 I $D(^WV(790.02,DUZ(2),5,WVLOOP)) Q 1 ;code is on list to be tracked
53 Q 0
54 ;
Note: See TracBrowser for help on using the repository browser.