| [613] | 1 | FBUCLNK1 ;ALBISC/TET - LINK CLAIM DISPLAY
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | LINK(FBDA,FBIX,FBSET) ;determine if link claims exist
|
|---|
| 5 | ;INPUT: FBDA = ien of unauthoriezed claim
|
|---|
| 6 | ; FBIX = xref indicating how user is looking up (APMS,AVMS,AOMS)
|
|---|
| 7 | ; FBSET = (optional) 1 to set global array, 0 to not set
|
|---|
| 8 | ;OUTPUT: 1 if claim is linked to others, 0 if not
|
|---|
| 9 | ; TMP("FBAR" global array (if 1 and flagged to set)
|
|---|
| 10 | I '+$G(FBDA) Q 0 S:$G(FBSET)']"" FBSET=0
|
|---|
| 11 | N FBCT,FBDCT,FBI,FBMC,FBZ S FBMC=+$P($$FBZ^FBUCUTL(FBDA),U,20) I 'FBMC Q 0
|
|---|
| 12 | 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
|
|---|
| 13 | .;set array
|
|---|
| 14 | .D DA^FBUCUTL5(FBI,"APMS",.FBDCT,+$P(FBZ,U,20),FBZ)
|
|---|
| 15 | I FBCT,FBSET D FBAR^FBUCUTL5(FBCT)
|
|---|
| 16 | Q $S(FBCT:1,1:0)
|
|---|
| 17 | ;
|
|---|
| 18 | ENTER(FBDA,FBUCA,DISP,FBIX) ;link claim on entry
|
|---|
| 19 | ;called from fbucen - enter new unauth claim
|
|---|
| 20 | ;INPUT: FBDA = ien of unauthorized claim
|
|---|
| 21 | ; FBUCA = after node of unauthorized claim
|
|---|
| 22 | ; DISP = 0 to display only, 1 to update
|
|---|
| 23 | ; FBIX = cross-ref (optional)
|
|---|
| 24 | ;VAR: FBTFROM-treatment from date/FBTTO-treatment to date/FBVET-veteran
|
|---|
| 25 | ;OUTPUT: link new claim to existing claim, if user so designates
|
|---|
| 26 | ; data stored in tmp(fbar/tmp(fbary global arrays
|
|---|
| 27 | N FBAR,FBARY,FBCNT,FBDCT,FBI,FBLINK,FBMC,FBOUT,FBTFROM,FBTTO,FBVET,FBX,FBZ S FBDCT=0
|
|---|
| 28 | 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))
|
|---|
| 29 | 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)
|
|---|
| 30 | D FBAR^FBUCUTL5(FBDCT)
|
|---|
| 31 | 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)
|
|---|
| 32 | I 'DISP,+$G(FBLINK),+$G(FBAR) S FBX="< ASSOCIATED CLAIMS >" W !!?(IOM-$L(FBX)/2),FBX,! D DISPX^FBUCUTL1(0)
|
|---|
| 33 | K ^TMP("FBAR",$J),^TMP("FBARY",$J) Q
|
|---|
| 34 | ;
|
|---|
| 35 | UNLINK(FBGROUP,FBDA,FBZ,FBRELINK) ;unlink claim from group/determine new primary claim
|
|---|
| 36 | ;INPUT: FBGROUP = # in group^# of programs^1 if auth^# of u/c w/same status^# of diff dispositions
|
|---|
| 37 | ; FBGROUP(ien of 162.7) = prog^auth ien^status ien^dispositon ien
|
|---|
| 38 | ; FBDA = ien of unauth claim working with
|
|---|
| 39 | ; FBZ = zero node of unauth claim (fbda)
|
|---|
| 40 | ; FBRELINK = <optional> flag to auto relink: 1 for auto-relink
|
|---|
| 41 | ;OUTPUT: fbda claim is unlinked; if group and fbda primary, new primary
|
|---|
| 42 | ; if another claim exists with same vet and episode of care,
|
|---|
| 43 | ; the unlinked claim may be relinked to it.
|
|---|
| 44 | I $S('+$G(FBGROUP):1,'+$G(FBDA):1,$G(FBZ)']"":1,1:0) Q
|
|---|
| 45 | S FBRELINK=+$G(FBRELINK) N FBALL,FBD,FBDIRA,FBI,FBMATCH,FBO,FBOUT,FBPRIME,FBTFR,FBTTO,FBVET ;other variables
|
|---|
| 46 | S (FBALL,FBMATCH,FBOUT)=0
|
|---|
| 47 | S FBPRIME=$$PRIME^FBUCUTL4(FBDA,FBZ) D:FBPRIME PRIME(.FBGROUP,FBDA,FBZ) I 'FBPRIME D DIE^FBUCUTL2("^FB583(",FBDA,"20////^S X="_FBDA)
|
|---|
| 48 | S FBVET=$P(FBZ,U,4),FBTFR=$P(FBZ,U,5),FBTTO=$P(FBZ,U,6),FBD=FBTFR-.1
|
|---|
| 49 | 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)
|
|---|
| 50 | Q:'FBMATCH ;nothing else to which this claim can be grouped
|
|---|
| 51 | I 'FBRELINK S FBDIRA="Do you want to automatically link this claim with another group" D READ^FBUCUTL7(FBDIRA,.FBOUT) Q:FBOUT!('FBALL)
|
|---|
| 52 | I FBALL D DIE^FBUCUTL2("^FB583(",FBDA,"20////^S X="_FBMATCH)
|
|---|
| 53 | Q
|
|---|
| 54 | PRIME(FBGROUP,FBDA,FBZ) ;determine primary claim
|
|---|
| 55 | ;INPUT: FBGROUP = # in group^# of programs^1 if auth^# of u/c w/same status^# of diff dispositions
|
|---|
| 56 | ; FBGROUP(ien of 162.7) = prog^auth ien^status ien^dispositon ien
|
|---|
| 57 | ; FBDA = ien of unauth claim
|
|---|
| 58 | ; FBZ = zero node of unauth claim (fbda)
|
|---|
| 59 | ;OUTPUT: if primary, find new primary for other claims in group and update
|
|---|
| 60 | N FBPRIME,FBI,FBO
|
|---|
| 61 | ;determine new primary claim; reset rest in group to new primary
|
|---|
| 62 | S (FBI,FBPRIME)=0 F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA S FBPRIME=FBI Q:FBPRIME
|
|---|
| 63 | 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)
|
|---|
| 64 | Q
|
|---|
