| 1 | WVRALIN1 ;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 | ;
|
|---|
| 4 | FIND ; 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
|
|---|
| 24 | LINK ; 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
|
|---|
| 41 | VNVEC() ; 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 | ;
|
|---|
