- 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 Feb 19, 2025@00:14:01 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 ;
