WVRALIN1 ;HCIOFO/FT-RAD/NM-WOMEN'S HEALTH LINK (cont.) ;2/18/00 10:58
;;1.0;WOMEN'S HEALTH;**5,10**;Sep 30, 1998
;
FIND ; Try to associate an incoming RAD/NM entry with an existing WH
; procedure that has no link to RAD/NM entry.
; Called from WVRALINK.
; Input variables needed:
; DFN - patient ien
; WVPROC - ien of WV Procedure Type (790.2)
; WVDATE - date portion of date of rad/nm procedure
;
; First, loop through Date of Procedure x-ref
N WVDTECHK,WVFLAG,WVIEN,WVLOOP,WVNODE
S WVDTECHK=WVDATE_".999999",WVFLAG=0,WVLOOP=WVDATE-.000001
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
.S WVNODE=$G(^WV(790.1,WVIEN,0)) Q:WVNODE=""
.Q:$P(WVNODE,U,15)]"" ;already has a rad/nm link
.Q:$P(WVNODE,U,2)'=DFN ;not the same patient
.Q:$P(WVNODE,U,4)'=WVPROC ;not the same procedure
.D LINK
.S WVFLAG=1 ;flag that link is made to an existing record, so quit loop
.Q
Q
LINK ; Update values in existing entry including day-case # link.
; Input variables needed:
; WVNODE - zero node of a File 790.1 entry.
; WVIEN - File 790.1 ien
Q:$G(WVNODE)="" Q:'$G(WVIEN)
N DIE,DA,DR
S DIE="^WV(790.1,",DA=WVIEN
; fill in missing data where possible.
S DR=".15////"_WVCASE ;radiology mam case# (i.e., link to RAD/NM entry)
I $P(WVNODE,U,5)="",$G(WVBWDX)]"" S DR=DR_";.05////"_WVBWDX ;result/dx
I $P(WVNODE,U,7)="",$G(WVPROV)]"" S DR=DR_";.07////"_WVPROV ;provider
I $P(WVNODE,U,9)="",$G(WVMOD)]"" S DR=DR_";.09////"_WVMOD ;modifier
I $P(WVNODE,U,10)="",$G(DUZ(2))]"" S DR=DR_";.1////"_DUZ(2) ;facility
I $P(WVNODE,U,11)="",$G(WVLOC)]"" S DR=DR_";.11////"_WVLOC ;location
I $P(WVNODE,U,35)="",$G(WVCREDIT)]"" S DR=DR_";.35////"_WVCREDIT ;rad/nm credit method
D ^DIE
Q
VNVEC() ; Veteran/Non-Veteran/Eligibility Code check
; DFN must be defined
; Returns 1 - veteran
; include all non-vets flag set to YES
; non-vet patient's eligibility code is on list to track
N WVALL,WVLOOP,X,Y
I $E($$VET^WVUTL1A(DFN))="Y" Q 1 ;veteran
S WVALL=$P($G(^WV(790.02,DUZ(2),0)),U,25) ;include all non-vets
I WVALL=1!(WVALL="") Q 1 ;1=YES
S WVLOOP=+$$ELIG^WVUTL9(DFN) ;internal^external elig code
I 'WVLOOP Q 0 ;no eligibility code
I $D(^WV(790.02,DUZ(2),5,WVLOOP)) Q 1 ;code is on list to be tracked
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRALIN1 2412 printed Dec 13, 2024@02:47:34 Page 2
WVRALIN1 ;HCIOFO/FT-RAD/NM-WOMEN'S HEALTH LINK (cont.) ;2/18/00 10:58
+1 ;;1.0;WOMEN'S HEALTH;**5,10**;Sep 30, 1998
+2 ;
FIND ; Try to associate an incoming RAD/NM entry with an existing WH
+1 ; procedure that has no link to RAD/NM entry.
+2 ; Called from WVRALINK.
+3 ; Input variables needed:
+4 ; DFN - patient ien
+5 ; WVPROC - ien of WV Procedure Type (790.2)
+6 ; WVDATE - date portion of date of rad/nm procedure
+7 ;
+8 ; First, loop through Date of Procedure x-ref
+9 NEW WVDTECHK,WVFLAG,WVIEN,WVLOOP,WVNODE
+10 SET WVDTECHK=WVDATE_".999999"
SET WVFLAG=0
SET WVLOOP=WVDATE-.000001
+11 FOR
SET WVLOOP=$ORDER(^WV(790.1,"D",WVLOOP))
if 'WVLOOP!(WVLOOP>WVDTECHK)!(WVFLAG)
QUIT
SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.1,"D",WVLOOP,WVIEN))
if 'WVIEN!(WVFLAG)
QUIT
Begin DoDot:1
+12 SET WVNODE=$GET(^WV(790.1,WVIEN,0))
if WVNODE=""
QUIT
+13 ;already has a rad/nm link
if $PIECE(WVNODE,U,15)]""
QUIT
+14 ;not the same patient
if $PIECE(WVNODE,U,2)'=DFN
QUIT
+15 ;not the same procedure
if $PIECE(WVNODE,U,4)'=WVPROC
QUIT
+16 DO LINK
+17 ;flag that link is made to an existing record, so quit loop
SET WVFLAG=1
+18 QUIT
End DoDot:1
+19 QUIT
LINK ; Update values in existing entry including day-case # link.
+1 ; Input variables needed:
+2 ; WVNODE - zero node of a File 790.1 entry.
+3 ; WVIEN - File 790.1 ien
+4 if $GET(WVNODE)=""
QUIT
if '$GET(WVIEN)
QUIT
+5 NEW DIE,DA,DR
+6 SET DIE="^WV(790.1,"
SET DA=WVIEN
+7 ; fill in missing data where possible.
+8 ;radiology mam case# (i.e., link to RAD/NM entry)
SET DR=".15////"_WVCASE
+9 ;result/dx
IF $PIECE(WVNODE,U,5)=""
IF $GET(WVBWDX)]""
SET DR=DR_";.05////"_WVBWDX
+10 ;provider
IF $PIECE(WVNODE,U,7)=""
IF $GET(WVPROV)]""
SET DR=DR_";.07////"_WVPROV
+11 ;modifier
IF $PIECE(WVNODE,U,9)=""
IF $GET(WVMOD)]""
SET DR=DR_";.09////"_WVMOD
+12 ;facility
IF $PIECE(WVNODE,U,10)=""
IF $GET(DUZ(2))]""
SET DR=DR_";.1////"_DUZ(2)
+13 ;location
IF $PIECE(WVNODE,U,11)=""
IF $GET(WVLOC)]""
SET DR=DR_";.11////"_WVLOC
+14 ;rad/nm credit method
IF $PIECE(WVNODE,U,35)=""
IF $GET(WVCREDIT)]""
SET DR=DR_";.35////"_WVCREDIT
+15 DO ^DIE
+16 QUIT
VNVEC() ; Veteran/Non-Veteran/Eligibility Code check
+1 ; DFN must be defined
+2 ; Returns 1 - veteran
+3 ; include all non-vets flag set to YES
+4 ; non-vet patient's eligibility code is on list to track
+5 NEW WVALL,WVLOOP,X,Y
+6 ;veteran
IF $EXTRACT($$VET^WVUTL1A(DFN))="Y"
QUIT 1
+7 ;include all non-vets
SET WVALL=$PIECE($GET(^WV(790.02,DUZ(2),0)),U,25)
+8 ;1=YES
IF WVALL=1!(WVALL="")
QUIT 1
+9 ;internal^external elig code
SET WVLOOP=+$$ELIG^WVUTL9(DFN)
+10 ;no eligibility code
IF 'WVLOOP
QUIT 0
+11 ;code is on list to be tracked
IF $DATA(^WV(790.02,DUZ(2),5,WVLOOP))
QUIT 1
+12 QUIT 0
+13 ;
