65 lines
4.2 KiB
Mathematica
65 lines
4.2 KiB
Mathematica
FBUCLNK1 ;ALBISC/TET - LINK CLAIM DISPLAY
|
|
;;3.5;FEE BASIS;;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
LINK(FBDA,FBIX,FBSET) ;determine if link claims exist
|
|
;INPUT: FBDA = ien of unauthoriezed claim
|
|
; FBIX = xref indicating how user is looking up (APMS,AVMS,AOMS)
|
|
; FBSET = (optional) 1 to set global array, 0 to not set
|
|
;OUTPUT: 1 if claim is linked to others, 0 if not
|
|
; TMP("FBAR" global array (if 1 and flagged to set)
|
|
I '+$G(FBDA) Q 0 S:$G(FBSET)']"" FBSET=0
|
|
N FBCT,FBDCT,FBI,FBMC,FBZ S FBMC=+$P($$FBZ^FBUCUTL(FBDA),U,20) I 'FBMC Q 0
|
|
S (FBDCT,FBCT,FBI)=0 F S FBI=$O(^FB583("AMC",FBMC,FBI)) Q:'FBI!(FBCT&('FBSET)) I FBI'=FBDA S FBCT=FBCT+1 I FBSET S FBZ=$G(^FB583(FBI,0)) I FBZ]"" D
|
|
.;set array
|
|
.D DA^FBUCUTL5(FBI,"APMS",.FBDCT,+$P(FBZ,U,20),FBZ)
|
|
I FBCT,FBSET D FBAR^FBUCUTL5(FBCT)
|
|
Q $S(FBCT:1,1:0)
|
|
;
|
|
ENTER(FBDA,FBUCA,DISP,FBIX) ;link claim on entry
|
|
;called from fbucen - enter new unauth claim
|
|
;INPUT: FBDA = ien of unauthorized claim
|
|
; FBUCA = after node of unauthorized claim
|
|
; DISP = 0 to display only, 1 to update
|
|
; FBIX = cross-ref (optional)
|
|
;VAR: FBTFROM-treatment from date/FBTTO-treatment to date/FBVET-veteran
|
|
;OUTPUT: link new claim to existing claim, if user so designates
|
|
; data stored in tmp(fbar/tmp(fbary global arrays
|
|
N FBAR,FBARY,FBCNT,FBDCT,FBI,FBLINK,FBMC,FBOUT,FBTFROM,FBTTO,FBVET,FBX,FBZ S FBDCT=0
|
|
S:$G(FBIX)']"" FBIX="APMS" S FBTFROM=$P(FBUCA,U,5),FBTTO=$P(FBUCA,U,6),FBVET=$P(FBUCA,U,4),FBMC=+$P(FBUCA,U,20),FBX=+$O(^FB583("APF",FBVET,FBTFROM,0))
|
|
I FBX'=FBDA S FBLINK=1,FBI=0 F S FBI=$O(^FB583("APF",FBVET,FBTFROM,FBI)) Q:'FBI S FBZ=$$FBZ^FBUCUTL(FBI) I $P(FBZ,U,6)=FBTTO,$$LINKTO^FBUCUTL4(FBI,FBZ,FBDA),FBI'=FBDA D DA^FBUCUTL5(FBI,FBIX,.FBDCT,FBMC,FBZ)
|
|
D FBAR^FBUCUTL5(FBDCT)
|
|
I DISP,+$G(FBLINK),+$G(FBAR) D ASK^FBUCLINK Q:+$G(FBOUT) I FBLINK D SELECT^FBUCLINK(+FBAR) Q:+$G(FBOUT) D:FBLINK UPD^FBUCLINK(FBDA,FBLINK)
|
|
I 'DISP,+$G(FBLINK),+$G(FBAR) S FBX="< ASSOCIATED CLAIMS >" W !!?(IOM-$L(FBX)/2),FBX,! D DISPX^FBUCUTL1(0)
|
|
K ^TMP("FBAR",$J),^TMP("FBARY",$J) Q
|
|
;
|
|
UNLINK(FBGROUP,FBDA,FBZ,FBRELINK) ;unlink claim from group/determine new primary claim
|
|
;INPUT: FBGROUP = # in group^# of programs^1 if auth^# of u/c w/same status^# of diff dispositions
|
|
; FBGROUP(ien of 162.7) = prog^auth ien^status ien^dispositon ien
|
|
; FBDA = ien of unauth claim working with
|
|
; FBZ = zero node of unauth claim (fbda)
|
|
; FBRELINK = <optional> flag to auto relink: 1 for auto-relink
|
|
;OUTPUT: fbda claim is unlinked; if group and fbda primary, new primary
|
|
; if another claim exists with same vet and episode of care,
|
|
; the unlinked claim may be relinked to it.
|
|
I $S('+$G(FBGROUP):1,'+$G(FBDA):1,$G(FBZ)']"":1,1:0) Q
|
|
S FBRELINK=+$G(FBRELINK) N FBALL,FBD,FBDIRA,FBI,FBMATCH,FBO,FBOUT,FBPRIME,FBTFR,FBTTO,FBVET ;other variables
|
|
S (FBALL,FBMATCH,FBOUT)=0
|
|
S FBPRIME=$$PRIME^FBUCUTL4(FBDA,FBZ) D:FBPRIME PRIME(.FBGROUP,FBDA,FBZ) I 'FBPRIME D DIE^FBUCUTL2("^FB583(",FBDA,"20////^S X="_FBDA)
|
|
S FBVET=$P(FBZ,U,4),FBTFR=$P(FBZ,U,5),FBTTO=$P(FBZ,U,6),FBD=FBTFR-.1
|
|
F S FBD=$O(^FB583("APF",FBVET,FBD)) Q:'FBD!(FBD>FBTFR) S FBI=0 F S FBI=$O(^FB583("APF",FBVET,FBD,FBI)) Q:'FBI!(FBMATCH) I FBI'=FBDA S FBO=$G(^FB583(FBI,0)) I $P(FBO,U,6)=FBTTO,'$D(FBGROUP(FBI)) S FBMATCH=+$P(FBO,U,20)
|
|
Q:'FBMATCH ;nothing else to which this claim can be grouped
|
|
I 'FBRELINK S FBDIRA="Do you want to automatically link this claim with another group" D READ^FBUCUTL7(FBDIRA,.FBOUT) Q:FBOUT!('FBALL)
|
|
I FBALL D DIE^FBUCUTL2("^FB583(",FBDA,"20////^S X="_FBMATCH)
|
|
Q
|
|
PRIME(FBGROUP,FBDA,FBZ) ;determine primary claim
|
|
;INPUT: FBGROUP = # in group^# of programs^1 if auth^# of u/c w/same status^# of diff dispositions
|
|
; FBGROUP(ien of 162.7) = prog^auth ien^status ien^dispositon ien
|
|
; FBDA = ien of unauth claim
|
|
; FBZ = zero node of unauth claim (fbda)
|
|
;OUTPUT: if primary, find new primary for other claims in group and update
|
|
N FBPRIME,FBI,FBO
|
|
;determine new primary claim; reset rest in group to new primary
|
|
S (FBI,FBPRIME)=0 F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA S FBPRIME=FBI Q:FBPRIME
|
|
I FBPRIME S FBI=0 F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA S FBO=$G(^FB583(FBI,0)) D DIE^FBUCUTL2("^FB583(",FBI,"20////^S X="_FBPRIME)
|
|
Q
|