- FBUCED0 ;ALBISC/TET - UPDATE UNAUTHORIZED GROUP ;10/07/2014
- ;;3.5;FEE BASIS;**27,154**;JAN 30, 1995;Build 12
- ;;Per VA Directive 6402, this routine should not be modified.
- EDIT(FBDR,FBACT,FBOUT,FBARY) ;called from fbuced, edit to 162.7
- ;INPUT: FBDR = template to be edited
- ; FBACT = action on claim (DIS = disposition, REO = reopen, etc)
- ; FBOUT = exit flag, 1 to exit
- ; FBARY = count;positions of output array in tmp(fbary
- ;OUTPUT: FBOUT = 1 if exited
- ; update unauthorized claim
- ;get fbda from array
- Q:'+$G(FBARY)!($G(FBDR)']"")!($G(FBACT)']"") S FBOUT=+$G(FBOUT)
- N FBDIRA,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=+$P(FBNODE,";") D Q:FBOUT
- .N DA,DIE,DR,FBALL,FBDISP,FBGROUP,FBUCA,FBUCAA,FBUCP,FBUCPA,FBUCPDX,FBY,Y
- .I +$G(FBARY)>1 D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
- .D PRIOR^FBUCEVT(FBDA,FBACT) S:FBACT="EDT"!(FBACT="REO") FBUCPDX=$G(^FB583(FBDA,"DX"))
- .I FBACT="DIS",$D(FBUCP),$P($G(FBUCP),"^",3)="" W !,"Vendor information is required for disposition." Q
- .I FBACT="DIS",$D(FBUCP),$P($G(FBUCP),"^",10)="" W !,"Patient Type Code is required for disposition." Q
- .S DIE="^FB583(",DA=FBDA,DR=FBDR,FBDISP=0 D LOCK^FBUCUTL(DIE,DA,0) I FBLOCK D ^DIE I $D(DTOUT) S FBOUT=1,DR="[FB UNAUTHORIZED PREVIOUS]",DA=FBDA D AFTER^FBUCEVT(DA,FBACT),^DIE L -^FB583(FBDA) K FBLOCK
- .I 'FBOUT S FBY=$S($D(Y):1,1:0) D AFTER^FBUCEVT(FBDA,FBACT) L -^FB583(FBDA) K FBLOCK D CKAUTH^FBUCUTL6(FBUCP,.FBUCA,FBDA),UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT) I FBACT="REO",'FBY&($$EDOK^FBUCUTL3(FBDA)) D
- ..;keep authoriziation info in synch for claim being edited via reopen
- ..N DA,DIE,DR,FBAIEN,FBAUTH,FBIEN,FBLOCK S FBAUTH=$$AUTH^FBUCUTL6(FBUCP,FBUCA)
- ..Q:FBAUTH=1!(FBAUTH=0) S FBAIEN=+$P(FBUCA,U,27) Q:'FBAIEN S FBIEN=FBAIEN
- ..S DA=+$P(FBUCP,U,4),DIE="^FBAAA(",DR="[FB UNAUTHORIZED EDIT]"
- ..D LOCK^FBUCUTL(DIE,DA,0) I FBLOCK D ^DIE L -^FBAAA(+$P(FBUCP,U,4)) S:$D(DTOUT) FBOUT=1 K DTOUT
- .;keep veteran & treatment from/to (what constitutes a group) in synch for rest in group
- .S FBALL=0 D GROUP^FBUCUTL7(FBUCP,FBDA),DISPLAY^FBUCUTL7(FBDA,.FBGROUP)
- .I +$G(FBDISP),$P(FBUCP,U,4,6)'=$P(FBUCA,U,4,6) S FBDIRA="Shall other claims be updated to same veteran & treat. from/to dates" D READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP) D Q:FBOUT
- ..I FBOUT S FBALL=0 ;if timeout during read, force an unlink
- ..I 'FBALL D UNLINK^FBUCLNK1(.FBGROUP,FBDA,FBUCA) Q ;unlink claim module
- ..I FBALL D
- ...N FBDR
- ...S FBDR="S:'+$P(FBUCA,U,4) Y=""@1"";2////^S X=+$P(FBUCA,U,4);S Y=3;@1;2///@;S:'+$P(FBUCA,U,5) Y=""@2"";3////^S X=+$P(FBUCA,U,5);S Y=4;@2;3///@;S:'+$P(FBUCA,U,6) Y=""@3"";4////^S X=+$P(FBUCA,U,6);S Y=""@99"";@3;4///@;@99"
- ...N FBI,FBLOCK S FBI=0 F S FBI=$O(FBGROUP(FBI)) Q:'FBI I FBI'=FBDA D DIE^FBUCUTL2("^FB583(",FBI,FBDR)
- .;if reopen or disposition, keep disposition and auth from/to dates in synch for same dispostion for rest in group, also keeps respective authorization in 161.01 in synch
- .I $S(FBUCA']"":1,FBACT'="REO"&(FBACT'="DIS")&(FBACT'="EDT"):1,FBACT="EDT"&(+$P(FBGROUP,U,5)):0,+$P(FBUCP,U,11)'=+$P(FBUCA,U,11)!($P(FBUCP,U,13,14)'=$P(FBUCA,U,13,14)):0,1:1) Q
- .S FBALL=0 D DISPLAY^FBUCUTL7(FBDA,.FBGROUP,"^"_+$P(FBUCP,U,24)_"^",+$P(FBUCP,U,11)) Q:'+FBDISP
- .I +$P(FBUCP,U,11)'=+$P(FBUCA,U,11) S FBDIRA="Shall all other claims be updated to the disposition" S:$P(FBUCP,U,13,14)'=$P(FBUCA,U,13,14) FBDIRA=FBDIRA_" & auth. from/to dates"
- .I $P(FBUCP,U,11)=$P(FBUCA,U,11) S FBDIRA="Shall all other claims be updated to the auth. from/to dates"
- .D READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP) I 'FBALL!(FBOUT) Q
- .I +$P(FBUCA,U,11)'=+$P(FBUCP,U,11),('($P(FBUCA,U,11)=1!($P(FBUCA,U,11)=4))) S DIR(0)="Y",DIR("A")="Shall disapproval reason apply to all other claims" D ^DIR K DIR Q:$D(DIRUT) S FBUCDISR=Y I Y D FBUCDISR(FBDA)
- .D K FBUCDISR
- ..N FBDR,FBI,FBODA,FBUCP,FBUCPA
- ..S FBDR="S:'+$P(FBUCA,U,13) Y=""@1"";12////^S X=+$P(FBUCA,U,13);S Y=13;@1;12///@;S:'+$P(FBUCA,U,14) Y=""@2"";13////^S X=+$P(FBUCA,U,14);S Y=10;@2;13///@;S:'+$P(FBUCA,U,11) Y=""@3"";10////^S X=+$P(FBUCA,U,11);S Y=""@99"";@3;10///@;@99"
- ..S FBODA=FBDA,FBI=0
- ..F S FBI=$O(FBDISP(FBI)) Q:'FBI I FBI'=FBODA D PRIOR^FBUCEVT(FBI,FBACT) D DIE^FBUCUTL2("^FB583(",FBI,FBDR) N FBUCA,FBUCAA D AFTER^FBUCEVT(FBI,FBACT) S FBDA=FBI D UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBI,FBACT,$G(FBUCDISR))
- Q
- FBUCDISR(FBDA) ;set up fbucdisr with disap. reasons for primary claim
- ;INPUT: ien of unauthorized claim (usually primary)
- ;OUTPUT: fbucdisr=1^ (1 indicates user wishes for all linked
- ; claims to contain same disapproval reason as primary
- ; pieces following will contain the pointer values
- ; of the disap. reasons for the primary del by ^
- N I
- I $D(^FB583(FBDA,"D")) S I=0 F S I=$O(^FB583(FBDA,"D",I)) Q:'I S FBUCDISR=FBUCDISR_"^"_+^FB583(FBDA,"D",I,0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCED0 4960 printed Mar 13, 2025@21:05:03 Page 2
- FBUCED0 ;ALBISC/TET - UPDATE UNAUTHORIZED GROUP ;10/07/2014
- +1 ;;3.5;FEE BASIS;**27,154**;JAN 30, 1995;Build 12
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- EDIT(FBDR,FBACT,FBOUT,FBARY) ;called from fbuced, edit to 162.7
- +1 ;INPUT: FBDR = template to be edited
- +2 ; FBACT = action on claim (DIS = disposition, REO = reopen, etc)
- +3 ; FBOUT = exit flag, 1 to exit
- +4 ; FBARY = count;positions of output array in tmp(fbary
- +5 ;OUTPUT: FBOUT = 1 if exited
- +6 ; update unauthorized claim
- +7 ;get fbda from array
- +8 if '+$GET(FBARY)!($GET(FBDR)']"")!($GET(FBACT)']"")
- QUIT
- SET FBOUT=+$GET(FBOUT)
- +9 NEW FBDIRA,FBDA,FBI,FBNODE,FBPL,FBW
- DO PARSE^FBUCUTL4(FBARY)
- +10 SET FBI=0
- FOR
- SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
- if 'FBI
- QUIT
- SET FBNODE=$GET(^(FBI))
- SET FBDA=+$PIECE(FBNODE,";")
- Begin DoDot:1
- +11 NEW DA,DIE,DR,FBALL,FBDISP,FBGROUP,FBUCA,FBUCAA,FBUCP,FBUCPA,FBUCPDX,FBY,Y
- +12 IF +$GET(FBARY)>1
- DO LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
- +13 DO PRIOR^FBUCEVT(FBDA,FBACT)
- if FBACT="EDT"!(FBACT="REO")
- SET FBUCPDX=$GET(^FB583(FBDA,"DX"))
- +14 IF FBACT="DIS"
- IF $DATA(FBUCP)
- IF $PIECE($GET(FBUCP),"^",3)=""
- WRITE !,"Vendor information is required for disposition."
- QUIT
- +15 IF FBACT="DIS"
- IF $DATA(FBUCP)
- IF $PIECE($GET(FBUCP),"^",10)=""
- WRITE !,"Patient Type Code is required for disposition."
- QUIT
- +16 SET DIE="^FB583("
- SET DA=FBDA
- SET DR=FBDR
- SET FBDISP=0
- DO LOCK^FBUCUTL(DIE,DA,0)
- IF FBLOCK
- DO ^DIE
- IF $DATA(DTOUT)
- SET FBOUT=1
- SET DR="[FB UNAUTHORIZED PREVIOUS]"
- SET DA=FBDA
- DO AFTER^FBUCEVT(DA,FBACT)
- DO ^DIE
- LOCK -^FB583(FBDA)
- KILL FBLOCK
- +17 IF 'FBOUT
- SET FBY=$SELECT($DATA(Y):1,1:0)
- DO AFTER^FBUCEVT(FBDA,FBACT)
- LOCK -^FB583(FBDA)
- KILL FBLOCK
- DO CKAUTH^FBUCUTL6(FBUCP,.FBUCA,FBDA)
- DO UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
- IF FBACT="REO"
- IF 'FBY&($$EDOK^FBUCUTL3(FBDA))
- Begin DoDot:2
- +18 ;keep authoriziation info in synch for claim being edited via reopen
- +19 NEW DA,DIE,DR,FBAIEN,FBAUTH,FBIEN,FBLOCK
- SET FBAUTH=$$AUTH^FBUCUTL6(FBUCP,FBUCA)
- +20 if FBAUTH=1!(FBAUTH=0)
- QUIT
- SET FBAIEN=+$PIECE(FBUCA,U,27)
- if 'FBAIEN
- QUIT
- SET FBIEN=FBAIEN
- +21 SET DA=+$PIECE(FBUCP,U,4)
- SET DIE="^FBAAA("
- SET DR="[FB UNAUTHORIZED EDIT]"
- +22 DO LOCK^FBUCUTL(DIE,DA,0)
- IF FBLOCK
- DO ^DIE
- LOCK -^FBAAA(+$PIECE(FBUCP,U,4))
- if $DATA(DTOUT)
- SET FBOUT=1
- KILL DTOUT
- End DoDot:2
- +23 ;keep veteran & treatment from/to (what constitutes a group) in synch for rest in group
- +24 SET FBALL=0
- DO GROUP^FBUCUTL7(FBUCP,FBDA)
- DO DISPLAY^FBUCUTL7(FBDA,.FBGROUP)
- +25 IF +$GET(FBDISP)
- IF $PIECE(FBUCP,U,4,6)'=$PIECE(FBUCA,U,4,6)
- SET FBDIRA="Shall other claims be updated to same veteran & treat. from/to dates"
- DO READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP)
- Begin DoDot:2
- +26 ;if timeout during read, force an unlink
- IF FBOUT
- SET FBALL=0
- +27 ;unlink claim module
- IF 'FBALL
- DO UNLINK^FBUCLNK1(.FBGROUP,FBDA,FBUCA)
- QUIT
- +28 IF FBALL
- Begin DoDot:3
- +29 NEW FBDR
- +30 SET FBDR="S:'+$P(FBUCA,U,4) Y=""@1"";2////^S X=+$P(FBUCA,U,4);S Y=3;@1;2///@;S:'+$P(FBUCA,U,5) Y=""@2"";3////^S X=+$P(FBUCA,U,5);S Y=4;@2;3///@;S:'+$P(FBUCA,U,6) Y=""@3"";4////^S X=+$P(FBUCA,U,6);S Y=""@99"";@3;4///@
- ;@99"
- +31 NEW FBI,FBLOCK
- SET FBI=0
- FOR
- SET FBI=$ORDER(FBGROUP(FBI))
- if 'FBI
- QUIT
- IF FBI'=FBDA
- DO DIE^FBUCUTL2("^FB583(",FBI,FBDR)
- End DoDot:3
- End DoDot:2
- if FBOUT
- QUIT
- +32 ;if reopen or disposition, keep disposition and auth from/to dates in synch for same dispostion for rest in group, also keeps respective authorization in 161.01 in synch
- +33 IF $SELECT(FBUCA']"":1,FBACT'="REO"&(FBACT'="DIS")&(FBACT'="EDT"):1,FBACT="EDT"&(+$PIECE(FBGROUP,U,5)):0,+$PIECE(FBUCP,U,11)'=+$PIECE(FBUCA,U,11)!($PIECE(FBUCP,U,13,14)'=$PIECE(FBUCA,U,13,14)):0,1:1)
- QUIT
- +34 SET FBALL=0
- DO DISPLAY^FBUCUTL7(FBDA,.FBGROUP,"^"_+$PIECE(FBUCP,U,24)_"^",+$PIECE(FBUCP,U,11))
- if '+FBDISP
- QUIT
- +35 IF +$PIECE(FBUCP,U,11)'=+$PIECE(FBUCA,U,11)
- SET FBDIRA="Shall all other claims be updated to the disposition"
- if $PIECE(FBUCP,U,13,14)'=$PIECE(FBUCA,U,13,14)
- SET FBDIRA=FBDIRA_" & auth. from/to dates"
- +36 IF $PIECE(FBUCP,U,11)=$PIECE(FBUCA,U,11)
- SET FBDIRA="Shall all other claims be updated to the auth. from/to dates"
- +37 DO READ^FBUCUTL7(FBDIRA,.FBOUT,.FBDISP)
- IF 'FBALL!(FBOUT)
- QUIT
- +38 IF +$PIECE(FBUCA,U,11)'=+$PIECE(FBUCP,U,11)
- IF ('($PIECE(FBUCA,U,11)=1!($PIECE(FBUCA,U,11)=4)))
- SET DIR(0)="Y"
- SET DIR("A")="Shall disapproval reason apply to all other claims"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- SET FBUCDISR=Y
- IF Y
- DO FBUCDISR(FBDA)
- +39 Begin DoDot:2
- +40 NEW FBDR,FBI,FBODA,FBUCP,FBUCPA
- +41 SET FBDR="S:'+$P(FBUCA,U,13) Y=""@1"";12////^S X=+$P(FBUCA,U,13);S Y=13;@1;12///@;S:'+$P(FBUCA,U,14) Y=""@2"";13////^S X=+$P(FBUCA,U,14);S Y=10;@2;13///@;S:'+$P(FBUCA,U,11) Y=""@3"";10////^S X=+$P(FBUCA,U,11);S Y=""@99"";@3;10///@;@
- 99"
- +42 SET FBODA=FBDA
- SET FBI=0
- +43 FOR
- SET FBI=$ORDER(FBDISP(FBI))
- if 'FBI
- QUIT
- IF FBI'=FBODA
- DO PRIOR^FBUCEVT(FBI,FBACT)
- DO DIE^FBUCUTL2("^FB583(",FBI,FBDR)
- NEW FBUCA,FBUCAA
- DO AFTER^FBUCEVT(FBI,FBACT)
- SET FBDA=FBI
- DO UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBI,FBACT,$GET(FBUCDISR))
- End DoDot:2
- KILL FBUCDISR
- End DoDot:1
- if FBOUT
- QUIT
- +44 QUIT
- FBUCDISR(FBDA) ;set up fbucdisr with disap. reasons for primary claim
- +1 ;INPUT: ien of unauthorized claim (usually primary)
- +2 ;OUTPUT: fbucdisr=1^ (1 indicates user wishes for all linked
- +3 ; claims to contain same disapproval reason as primary
- +4 ; pieces following will contain the pointer values
- +5 ; of the disap. reasons for the primary del by ^
- +6 NEW I
- +7 IF $DATA(^FB583(FBDA,"D"))
- SET I=0
- FOR
- SET I=$ORDER(^FB583(FBDA,"D",I))
- if 'I
- QUIT
- SET FBUCDISR=FBUCDISR_"^"_+^FB583(FBDA,"D",I,0)
- +8 QUIT
