WVLABAD1 ;HCIOFO/FT-LAB/WOMEN'S HEALTH LINK (cont.) ;4/6/99 12:33
;;1.0;WOMEN'S HEALTH;**6**;Sep 30, 1998
;
FIND ; Try to associate an incoming lab test entry with an existing WH
; procedure that has no link to a lab accession # to avoid duplicates.
; Called from WVLABADD.
; Input variables needed:
; DFN - patient ien
; WVPROC - ien of WV Procedure Type (790.2)
; WVDATE - date portion of date of lab test
;
; First, loop through Date of Procedure x-ref
N WVDTECHK,WVDATE0,WVFLAG,WVIEN,WVLOOP,WVNODE0,WVNODE2
S WVDATE0=$P(WVDATE,".",1)
S WVDTECHK=WVDATE0_".999999",WVFLAG=0,WVLOOP=WVDATE0-.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 WVNODE0=$G(^WV(790.1,WVIEN,0)) Q:WVNODE0=""
.S WVNODE2=$G(^WV(790.1,WVIEN,2))
.Q:$P(WVNODE2,U,17)]"" ;already has a lab test link
.Q:$P(WVNODE0,U,2)'=DFN ;not the same patient
.Q:$P(WVNODE0,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 lab accession# link.
; Input variables needed:
; WVNODE - zero node of a File 790.08 entry.
; WVNODE0 - 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="2.17////"_$P(WVNODE,U,1) ;lab accession#
S DR=DR_";2.18////"_$P(WVNODE,U,36) ;lab data file (#63) ien
S DR=DR_";2.19////"_$P(WVNODE,U,37) ;lab inverse date/time
S DR=DR_";2.2////"_$P(WVNODE,U,38) ;lab subscript (CY or SP)
I $P(WVNODE0,U,7)="",$P(WVNODE,U,7)]"" S DR=DR_";.07////"_$P(WVNODE,U,7) ;provider
I $P(WVNODE0,U,10)="",$G(DUZ(2))]"" S DR=DR_";.1////"_$G(DUZ(2)) ;facility
I $P(WVNODE0,U,11)="",$P(WVNODE,U,11)]"" S DR=DR_";.11////"_$P(WVNODE,U,11) ;location
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVLABAD1 1957 printed Apr 09, 2024@21:50:06 Page 2
WVLABAD1 ;HCIOFO/FT-LAB/WOMEN'S HEALTH LINK (cont.) ;4/6/99 12:33
+1 ;;1.0;WOMEN'S HEALTH;**6**;Sep 30, 1998
+2 ;
FIND ; Try to associate an incoming lab test entry with an existing WH
+1 ; procedure that has no link to a lab accession # to avoid duplicates.
+2 ; Called from WVLABADD.
+3 ; Input variables needed:
+4 ; DFN - patient ien
+5 ; WVPROC - ien of WV Procedure Type (790.2)
+6 ; WVDATE - date portion of date of lab test
+7 ;
+8 ; First, loop through Date of Procedure x-ref
+9 NEW WVDTECHK,WVDATE0,WVFLAG,WVIEN,WVLOOP,WVNODE0,WVNODE2
+10 SET WVDATE0=$PIECE(WVDATE,".",1)
+11 SET WVDTECHK=WVDATE0_".999999"
SET WVFLAG=0
SET WVLOOP=WVDATE0-.000001
+12 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
+13 SET WVNODE0=$GET(^WV(790.1,WVIEN,0))
if WVNODE0=""
QUIT
+14 SET WVNODE2=$GET(^WV(790.1,WVIEN,2))
+15 ;already has a lab test link
if $PIECE(WVNODE2,U,17)]""
QUIT
+16 ;not the same patient
if $PIECE(WVNODE0,U,2)'=DFN
QUIT
+17 ;not the same procedure
if $PIECE(WVNODE0,U,4)'=WVPROC
QUIT
+18 DO LINK
+19 ;flag that link is made to an existing record, so quit loop
SET WVFLAG=1
+20 QUIT
End DoDot:1
+21 QUIT
LINK ; Update values in existing entry including lab accession# link.
+1 ; Input variables needed:
+2 ; WVNODE - zero node of a File 790.08 entry.
+3 ; WVNODE0 - zero node of a File 790.1 entry
+4 ; WVIEN - File 790.1 ien
+5 if $GET(WVNODE)=""
QUIT
if '$GET(WVIEN)
QUIT
+6 NEW DIE,DA,DR
+7 SET DIE="^WV(790.1,"
SET DA=WVIEN
+8 ; fill in missing data where possible.
+9 ;lab accession#
SET DR="2.17////"_$PIECE(WVNODE,U,1)
+10 ;lab data file (#63) ien
SET DR=DR_";2.18////"_$PIECE(WVNODE,U,36)
+11 ;lab inverse date/time
SET DR=DR_";2.19////"_$PIECE(WVNODE,U,37)
+12 ;lab subscript (CY or SP)
SET DR=DR_";2.2////"_$PIECE(WVNODE,U,38)
+13 ;provider
IF $PIECE(WVNODE0,U,7)=""
IF $PIECE(WVNODE,U,7)]""
SET DR=DR_";.07////"_$PIECE(WVNODE,U,7)
+14 ;facility
IF $PIECE(WVNODE0,U,10)=""
IF $GET(DUZ(2))]""
SET DR=DR_";.1////"_$GET(DUZ(2))
+15 ;location
IF $PIECE(WVNODE0,U,11)=""
IF $PIECE(WVNODE,U,11)]""
SET DR=DR_";.11////"_$PIECE(WVNODE,U,11)
+16 DO ^DIE
+17 QUIT
