FBUCLINK ;ALBISC/TET - LINK CLAIM TO A PRIMARY ;10/07/2014
 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
 ;;Per VA Directive 6402, this routine should not be modified.
EDIT ;associate claims to a primary ;call from FBUC ASSOCIATE option
 ;INPUT:  none
 ;VAR:    FBLINK = ien of master claim #
 ;OUTPUT:  none; if fblink will update
 N FBACT S FBACT="LNK",FBO=0 D LOOKUP^FBUCUTL3(FBO) G:FBOUT END
 Q:'+$G(FBARY)  N FBDA,FBI,FBNODE,FBPL,FBW D PARSE^FBUCUTL4(FBARY)
 S FBI=0 F  S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI  S FBNODE=$G(^(FBI)),FBDA=+FBNODE D  Q:FBOUT
 .N FBUCA,FBUCAA,FBUCP,FBUCPA,FBZ I +$G(FBARY)>1 D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
 .D PRIOR^FBUCEVT(FBDA,FBACT)
 .I '$$LINK^FBUCUTL4(FBDA,FBUCP) W !,"This claim has other claims associated with it",!,"and, therefore, can not be associated to another." Q
 .D ASSOC Q:FBOUT  D UPD(FBDA,FBLINK)
 .S FBZ=$$FBZ^FBUCUTL(FBDA) D EN^FBUCEN1(FBZ,FBDA)
 .D AFTER^FBUCEVT(FBDA,FBACT),UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
END ;kill and quit
 K DA,DIE,DIRUT,DR,DTOUT,DUOUT,FBAR,FBARY,FBDCT,FBI,FBLINK,FBO,FBOUT,FBP,FBPL,FBUCP,FBUCPA,FBW,FBX,FBZ,X,Y,^TMP("FBARY",$J) Q
ASSOC ;associate claim to a primary
 ;INPUT:  FBDA = ien of unauthorized claim to be linked
 ;        FBUCP = zero node of fbda
 ;OUTPUT: FBLINK = ien of unauthorized claim to which is linked
 ;        FBOUT = set if timed out or up-arrow entered
 S DIC="^FB583(",DIC(0)="AEMQZ",DIC("A")="Select the unauthorized claim to which this one should be associated: ",DIC("W")="D ID^FBUCUTL4"
 S DIC("S")="N FBZ S FBZ=$$FBZ^FBUCUTL(+Y) I $P(FBZ,U,4)=$P(FBUCP,U,4)&(+Y'=FBDA)&($$LINKTO^FBUCUTL4(+Y,FBZ,FBDA))&($P(FBZ,U,5)=$P(FBUCP,U,5))&($P(FBZ,U,6)=$P(FBUCP,U,6)) K FBZ"
 D ^DIC K DIC S:$D(DTOUT)!($D(DUOUT)) FBOUT=1 G:FBOUT!(Y'>0) ASSOCQ S FBLINK=+Y
ASSOCQ S FBLINK=+$G(FBLINK) K FBZ,Y Q
DISASSOC ;disassociate a claim, interactive, called from option
 N FBARY,FBDA,FBI,FBNODE,FBOUT,FBP,FBPL,FBW ;new variables here
 W !,"This option will allow you to disassociate a claim.",!
 D LOOKUP^FBUCUTL3(0)
 G:'+$G(FBARY) DISASSQ
 S FBOUT=0 D PARSE^FBUCUTL4(FBARY)
 S FBI=0 F  S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI!(FBOUT)  S FBNODE=$G(^(FBI)),FBDA=+$P(FBNODE,";") D  G:FBOUT DISASSQ
 .N FBALL,FBDIRA,FBDISP,FBGROUP,FBZ
 .D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
 .S FBZ=$G(^FB583(FBDA,0))
 .S FBALL=0 D GROUP^FBUCUTL7(FBZ,FBDA)
 .I +$G(FBGROUP)=1 W !,"This claim is not associated with another claim." Q
 .D DISPLAY^FBUCUTL7(FBDA,.FBGROUP) S FBDIRA="Do you wish to disassociate claim from the above group" D READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP) Q:FBOUT!('FBALL)
 .D UNLINK^FBUCLNK1(.FBGROUP,FBDA,FBZ)
DISASSQ K FBARY,^TMP("FBARY",$J) Q
UPD(FBDA,FBLINK) ;update master claim field
 ;INPUT:  FBDA = internal entry number of unauthorized claim for update
 ;        FBLINK = internal entry number of primary claim
 ;OUTPUT: update of MASTER CLAIM field
 N DA,DIE,DR,X,FBLOCK
 Q:'+$G(FBDA)!('+$G(FBLINK))  I +$G(FBLINK) S DA=FBDA,DIE="^FB583(",DR="20////^S X=FBLINK" D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(FBDA)
 Q
ARSET(FBDA,FBZ) ;set display array
 ;INPUT:  FBDA = ien of unauthorized claim record
 ;        FBZ = zero node of unauthorized claim
 ;OUTPUT: string of data for display
 N FBX I '+$G(FBDA)!($G(FBZ)']"") Q $G(FBX)
 S FBX=FBDA_";"_$S($$PRIME^FBUCUTL4(FBDA,FBZ):"*",1:"  ")_$E($$VET^FBUCUTL(+$P(FBZ,U,4)),1,12)_U_$E($$VEN^FBUCUTL(+$P(FBZ,U,3)),1,12)_U_$E($$PROG^FBUCUTL(+$P(FBZ,U,2)),1,12)_U_$$DATX^FBAAUTL(+$P(FBZ,U))
 S FBX=FBX_U_$E($$PTR^FBUCUTL("^FB(162.92,",+$P(FBZ,U,24)),1,16)
 S FBX=FBX_U_"TREATMENT FROM: "_$$DATX^FBAAUTL(+$P(FBZ,U,5))_U_"TREATMENT TO: "_$$DATX^FBAAUTL(+$P(FBZ,U,6))
 Q $G(FBX)
ASK ;ask if want to associate claim
 ;INPUT:  FBLINK = flag that another entry for vet and episode exists
 ;        FBAR & FBAR( = data for vet/episode of care to display
 ;OUTPUT: FBLINK = 1 is which to associate; 0 to associate to itself
 W !!,"Other claims exist for the same veteran and episode of care." H 1 D DISPX^FBUCUTL1(0,1)
 W ! S DIR("A")="Do you wish to associate this new claim with one from the above listing",DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR S:$D(DIRUT) FBOUT=1  S FBLINK=$S(Y=1:1,1:0)
 Q
SELECT(FBAR) ;select a claim from listing to link
 ;INPUT:  FBAR = (not subscripted), for upper limit
 ;OUTPUT: FBLINK = number of primary master claim or zero
 Q:'+$G(FBAR)  S DIR(0)="N^1:"_FBAR_":0",DIR("A")="Select the claim to which you wish to associate",DIR("??")="^D DISPX^FBUCUTL1(0,1)"
 D ^DIR K DIR S:$D(DIRUT) FBOUT=1 Q:+$G(FBOUT)  S FBLINK=+$G(^TMP("FBAR",$J,+Y))
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCLINK   4602     printed  Sep 23, 2025@19:36:24                                                                                                                                                                                                    Page 2
FBUCLINK  ;ALBISC/TET - LINK CLAIM TO A PRIMARY ;10/07/2014
 +1       ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
 +2       ;;Per VA Directive 6402, this routine should not be modified.
EDIT      ;associate claims to a primary ;call from FBUC ASSOCIATE option
 +1       ;INPUT:  none
 +2       ;VAR:    FBLINK = ien of master claim #
 +3       ;OUTPUT:  none; if fblink will update
 +4        NEW FBACT
           SET FBACT="LNK"
           SET FBO=0
           DO LOOKUP^FBUCUTL3(FBO)
           if FBOUT
               GOTO END
 +5        if '+$GET(FBARY)
               QUIT 
           NEW FBDA,FBI,FBNODE,FBPL,FBW
           DO PARSE^FBUCUTL4(FBARY)
 +6        SET FBI=0
           FOR 
               SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
               if 'FBI
                   QUIT 
               SET FBNODE=$GET(^(FBI))
               SET FBDA=+FBNODE
               Begin DoDot:1
 +7                NEW FBUCA,FBUCAA,FBUCP,FBUCPA,FBZ
                   IF +$GET(FBARY)>1
                       DO LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
 +8                DO PRIOR^FBUCEVT(FBDA,FBACT)
 +9                IF '$$LINK^FBUCUTL4(FBDA,FBUCP)
                       WRITE !,"This claim has other claims associated with it",!,"and, therefore, can not be associated to another."
                       QUIT 
 +10               DO ASSOC
                   if FBOUT
                       QUIT 
                   DO UPD(FBDA,FBLINK)
 +11               SET FBZ=$$FBZ^FBUCUTL(FBDA)
                   DO EN^FBUCEN1(FBZ,FBDA)
 +12               DO AFTER^FBUCEVT(FBDA,FBACT)
                   DO UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
               End DoDot:1
               if FBOUT
                   QUIT 
END       ;kill and quit
 +1        KILL DA,DIE,DIRUT,DR,DTOUT,DUOUT,FBAR,FBARY,FBDCT,FBI,FBLINK,FBO,FBOUT,FBP,FBPL,FBUCP,FBUCPA,FBW,FBX,FBZ,X,Y,^TMP("FBARY",$JOB)
           QUIT 
ASSOC     ;associate claim to a primary
 +1       ;INPUT:  FBDA = ien of unauthorized claim to be linked
 +2       ;        FBUCP = zero node of fbda
 +3       ;OUTPUT: FBLINK = ien of unauthorized claim to which is linked
 +4       ;        FBOUT = set if timed out or up-arrow entered
 +5        SET DIC="^FB583("
           SET DIC(0)="AEMQZ"
           SET DIC("A")="Select the unauthorized claim to which this one should be associated: "
           SET DIC("W")="D ID^FBUCUTL4"
 +6        SET DIC("S")="N FBZ S FBZ=$$FBZ^FBUCUTL(+Y) I $P(FBZ,U,4)=$P(FBUCP,U,4)&(+Y'=FBDA)&($$LINKTO^FBUCUTL4(+Y,FBZ,FBDA))&($P(FBZ,U,5)=$P(FBUCP,U,5))&($P(FBZ,U,6)=$P(FBUCP,U,6)) K FBZ"
 +7        DO ^DIC
           KILL DIC
           if $DATA(DTOUT)!($DATA(DUOUT))
               SET FBOUT=1
           if FBOUT!(Y'>0)
               GOTO ASSOCQ
           SET FBLINK=+Y
ASSOCQ     SET FBLINK=+$GET(FBLINK)
           KILL FBZ,Y
           QUIT 
DISASSOC  ;disassociate a claim, interactive, called from option
 +1       ;new variables here
           NEW FBARY,FBDA,FBI,FBNODE,FBOUT,FBP,FBPL,FBW
 +2        WRITE !,"This option will allow you to disassociate a claim.",!
 +3        DO LOOKUP^FBUCUTL3(0)
 +4        if '+$GET(FBARY)
               GOTO DISASSQ
 +5        SET FBOUT=0
           DO PARSE^FBUCUTL4(FBARY)
 +6        SET FBI=0
           FOR 
               SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
               if 'FBI!(FBOUT)
                   QUIT 
               SET FBNODE=$GET(^(FBI))
               SET FBDA=+$PIECE(FBNODE,";")
               Begin DoDot:1
 +7                NEW FBALL,FBDIRA,FBDISP,FBGROUP,FBZ
 +8                DO LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
 +9                SET FBZ=$GET(^FB583(FBDA,0))
 +10               SET FBALL=0
                   DO GROUP^FBUCUTL7(FBZ,FBDA)
 +11               IF +$GET(FBGROUP)=1
                       WRITE !,"This claim is not associated with another claim."
                       QUIT 
 +12               DO DISPLAY^FBUCUTL7(FBDA,.FBGROUP)
                   SET FBDIRA="Do you wish to disassociate claim from the above group"
                   DO READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP)
                   if FBOUT!('FBALL)
                       QUIT 
 +13               DO UNLINK^FBUCLNK1(.FBGROUP,FBDA,FBZ)
               End DoDot:1
               if FBOUT
                   GOTO DISASSQ
DISASSQ    KILL FBARY,^TMP("FBARY",$JOB)
           QUIT 
UPD(FBDA,FBLINK) ;update master claim field
 +1       ;INPUT:  FBDA = internal entry number of unauthorized claim for update
 +2       ;        FBLINK = internal entry number of primary claim
 +3       ;OUTPUT: update of MASTER CLAIM field
 +4        NEW DA,DIE,DR,X,FBLOCK
 +5        if '+$GET(FBDA)!('+$GET(FBLINK))
               QUIT 
           IF +$GET(FBLINK)
               SET DA=FBDA
               SET DIE="^FB583("
               SET DR="20////^S X=FBLINK"
               DO LOCK^FBUCUTL(DIE,DA,1)
               IF FBLOCK
                   DO ^DIE
                   LOCK -^FB583(FBDA)
 +6        QUIT 
ARSET(FBDA,FBZ) ;set display array
 +1       ;INPUT:  FBDA = ien of unauthorized claim record
 +2       ;        FBZ = zero node of unauthorized claim
 +3       ;OUTPUT: string of data for display
 +4        NEW FBX
           IF '+$GET(FBDA)!($GET(FBZ)']"")
               QUIT $GET(FBX)
 +5        SET FBX=FBDA_";"_$SELECT($$PRIME^FBUCUTL4(FBDA,FBZ):"*",1:"  ")_$EXTRACT($$VET^FBUCUTL(+$PIECE(FBZ,U,4)),1,12)_U_$EXTRACT($$VEN^FBUCUTL(+$PIECE(FBZ,U,3)),1,12)_U_$EXTRACT($$PROG^FBUCUTL(+$PIECE(FBZ,U,2)),1,12)_U_$$DATX^FBAAUTL(+$PIECE(FBZ,U))
 +6        SET FBX=FBX_U_$EXTRACT($$PTR^FBUCUTL("^FB(162.92,",+$PIECE(FBZ,U,24)),1,16)
 +7        SET FBX=FBX_U_"TREATMENT FROM: "_$$DATX^FBAAUTL(+$PIECE(FBZ,U,5))_U_"TREATMENT TO: "_$$DATX^FBAAUTL(+$PIECE(FBZ,U,6))
 +8        QUIT $GET(FBX)
ASK       ;ask if want to associate claim
 +1       ;INPUT:  FBLINK = flag that another entry for vet and episode exists
 +2       ;        FBAR & FBAR( = data for vet/episode of care to display
 +3       ;OUTPUT: FBLINK = 1 is which to associate; 0 to associate to itself
 +4        WRITE !!,"Other claims exist for the same veteran and episode of care."
           HANG 1
           DO DISPX^FBUCUTL1(0,1)
 +5        WRITE !
           SET DIR("A")="Do you wish to associate this new claim with one from the above listing"
           SET DIR("B")="YES"
           SET DIR(0)="Y"
           DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               SET FBOUT=1
           SET FBLINK=$SELECT(Y=1:1,1:0)
 +6        QUIT 
SELECT(FBAR) ;select a claim from listing to link
 +1       ;INPUT:  FBAR = (not subscripted), for upper limit
 +2       ;OUTPUT: FBLINK = number of primary master claim or zero
 +3        if '+$GET(FBAR)
               QUIT 
           SET DIR(0)="N^1:"_FBAR_":0"
           SET DIR("A")="Select the claim to which you wish to associate"
           SET DIR("??")="^D DISPX^FBUCUTL1(0,1)"
 +4        DO ^DIR
           KILL DIR
           if $DATA(DIRUT)
               SET FBOUT=1
           if +$GET(FBOUT)
               QUIT 
           SET FBLINK=+$GET(^TMP("FBAR",$JOB,+Y))
 +5        QUIT