FBUCUPD1 ;ALBISC/TET - UPDATE AFTER EVENT (CONTINUED) ;4/21/93 20:41
;;3.5;FEE BASIS;;JAN 30, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;called from fbucupd
AUTH(FBUCP,FBUCA,FBDA,FBACT) ;update authorization in authorization file
;INPUT: ;function call to determine action,
; 0 to kill/1 to set/2 to change/null for no change
; FBUCP - data prior to edit
; FBUCA - data after edit
; FBDA - ien of unauthorized claim, file 162.7
; FBACT - action type
;OUTPUT: -- update patient's authorization
; will add if entry not already there,
; delete or change if entry already there,
; otherwise will quit (based on variables FBAUTH and FBIEN)
; FBOUT = 1 if timed out, otherwise 0
N FBAUTH S FBAUTH=$$AUTH^FBUCUTL6(FBUCP,FBUCA) G:FBAUTH']"" AUTHQ
N FBAUTHF,FBDCHG,FBIEN,FBLOCK,FBV,FBVET,FBY,DA,DIC,DIE,DIK,DIR,DR,DTOUT,DUOUT,X,Y S FBDCHG=0 S:'$D(FBOUT) FBOUT=0
S FBV=FBDA_";FB583(" S:'$D(FBVET) FBVET=+$P(FBUCA,U,4),FBIEN=+$O(^FBAAA("AG",FBV,FBVET,0))
I FBAUTH'=1,FBIEN D ;delete or edit & entry exists
.I FBAUTH=0,'$$PAY^FBUCUTL(FBDA,"^FB583(") D
..N FBAIEN W !,"Deleting authorization...",!
..S DA(1)=FBVET,DA=FBIEN,DIK="^FBAAA("_DA(1)_",1," D ^DIK K DIK
..S FBAIEN=+$P(FBUCA,U,27) I FBAIEN D UPDATE1("@",FBDA)
.I FBAUTH=2 D UPDATE
I FBAUTH=1,FBIEN,FBACT="REO" D UPDATE
I FBAUTH=1,'FBIEN D ;add & entry not already in file
.;check if vet in file, if not add
.S Y=0 N FBAIEN,FBVAR I '$D(^FBAAA(FBVET,0)) S Y=$$FILE^FBUCUTL("^FBAAA(",FBVET,1) Q:+Y'>0 S FBVET=+Y,^FBAAA(FBVET,1,0)="^161.01D^^"
.I +Y'>0 S:'$D(^FBAAA(FBVET,1,0)) ^FBAAA(FBVET,1,0)="^161.01D^^"
.I "^6^7^"[$P(FBUCA,U,2) D
..S DIR(0)="161.01,.06",DIR("B")="DISCHARGE" D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) FBOUT=1
..I FBOUT&($P(FBUCA,U,2)=6) W !,*7,"Discharge type is missing! Enter using the Re-open Unauthorized Claim option.",! H 3
..S:'FBOUT FBDCHG=Y
.S DIE="^FBAAA("_FBVET_",1,",FBAUTHF=+$P(FBUCA,U,13) I FBAUTHF S Y=$$FILE^FBUCUTL(DIE,FBAUTHF,0,FBVET) Q:+Y'>0 S (FBAIEN,FBIEN)=+Y,DA=FBVET,DR="[FB UNAUTHORIZED UPDATE]",DIE="^FBAAA("
.I FBAUTHF D LOCK^FBUCUTL(DIE,FBVET,1) I FBLOCK D ^DIE L -^FBAAA(FBVET) K DA,DIE,DQ,DR,FBLOCK D UPDATE1(FBAIEN,FBDA) ;S:$D(DTOUT) FBOUT=1 I 'FBOUT D UPDATE1(FBAIEN,FBDA)
AUTHQ K DA,DIC,DIE,DQ,DR,DTOUT,DUOUT,FBDCHG,X,Y Q
UPDATE ;update if there is a change - keeps 583 and authorization in sync
N DA,DIE,DR,FBLOCK
S DA=FBVET,DR="[FB UNAUTHORIZED UPDATE1]",DIE="^FBAAA("
D LOCK^FBUCUTL(DIE,FBVET,1) I FBLOCK D ^DIE L -^FBAAA(FBVET)
Q
UPDATE1(FBAIEN,FBIEN) ;update authorization field (# 30) for unauthorized claim
;INPUT: FBAIEN = internal entry number of authorization (could be '@' for deletion
; FBIEN = internal entry number of u/c (may be fbda)
; FBALL = flag to update all other claims (1=update all)
;OUTPUT: update field 30 (AUTHORIZAITION) to value of fbaien
N DA,DIE,DR,FBLOCK I $S(+$G(FBAIEN)'>0&(FBAIEN'="@"):1,'+$G(FBIEN):1,FBAIEN'?1N.N&(FBAIEN'="@"):1,1:0) Q
S DA=FBIEN,DIE="^FB583(",DR="S:FBAIEN=""@"" Y=""@1"";30////^S X=FBAIEN;S Y=""@99"";@1;30///@;@99" D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(FBIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCUPD1 3240 printed Sep 23, 2025@19:36:33 Page 2
FBUCUPD1 ;ALBISC/TET - UPDATE AFTER EVENT (CONTINUED) ;4/21/93 20:41
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;called from fbucupd
AUTH(FBUCP,FBUCA,FBDA,FBACT) ;update authorization in authorization file
+1 ;INPUT: ;function call to determine action,
+2 ; 0 to kill/1 to set/2 to change/null for no change
+3 ; FBUCP - data prior to edit
+4 ; FBUCA - data after edit
+5 ; FBDA - ien of unauthorized claim, file 162.7
+6 ; FBACT - action type
+7 ;OUTPUT: -- update patient's authorization
+8 ; will add if entry not already there,
+9 ; delete or change if entry already there,
+10 ; otherwise will quit (based on variables FBAUTH and FBIEN)
+11 ; FBOUT = 1 if timed out, otherwise 0
+12 NEW FBAUTH
SET FBAUTH=$$AUTH^FBUCUTL6(FBUCP,FBUCA)
if FBAUTH']""
GOTO AUTHQ
+13 NEW FBAUTHF,FBDCHG,FBIEN,FBLOCK,FBV,FBVET,FBY,DA,DIC,DIE,DIK,DIR,DR,DTOUT,DUOUT,X,Y
SET FBDCHG=0
if '$DATA(FBOUT)
SET FBOUT=0
+14 SET FBV=FBDA_";FB583("
if '$DATA(FBVET)
SET FBVET=+$PIECE(FBUCA,U,4)
SET FBIEN=+$ORDER(^FBAAA("AG",FBV,FBVET,0))
+15 ;delete or edit & entry exists
IF FBAUTH'=1
IF FBIEN
Begin DoDot:1
+16 IF FBAUTH=0
IF '$$PAY^FBUCUTL(FBDA,"^FB583(")
Begin DoDot:2
+17 NEW FBAIEN
WRITE !,"Deleting authorization...",!
+18 SET DA(1)=FBVET
SET DA=FBIEN
SET DIK="^FBAAA("_DA(1)_",1,"
DO ^DIK
KILL DIK
+19 SET FBAIEN=+$PIECE(FBUCA,U,27)
IF FBAIEN
DO UPDATE1("@",FBDA)
End DoDot:2
+20 IF FBAUTH=2
DO UPDATE
End DoDot:1
+21 IF FBAUTH=1
IF FBIEN
IF FBACT="REO"
DO UPDATE
+22 ;add & entry not already in file
IF FBAUTH=1
IF 'FBIEN
Begin DoDot:1
+23 ;check if vet in file, if not add
+24 SET Y=0
NEW FBAIEN,FBVAR
IF '$DATA(^FBAAA(FBVET,0))
SET Y=$$FILE^FBUCUTL("^FBAAA(",FBVET,1)
if +Y'>0
QUIT
SET FBVET=+Y
SET ^FBAAA(FBVET,1,0)="^161.01D^^"
+25 IF +Y'>0
if '$DATA(^FBAAA(FBVET,1,0))
SET ^FBAAA(FBVET,1,0)="^161.01D^^"
+26 IF "^6^7^"[$PIECE(FBUCA,U,2)
Begin DoDot:2
+27 SET DIR(0)="161.01,.06"
SET DIR("B")="DISCHARGE"
DO ^DIR
KILL DIR
if $DATA(DUOUT)!($DATA(DTOUT))
SET FBOUT=1
+28 IF FBOUT&($PIECE(FBUCA,U,2)=6)
WRITE !,*7,"Discharge type is missing! Enter using the Re-open Unauthorized Claim option.",!
HANG 3
+29 if 'FBOUT
SET FBDCHG=Y
End DoDot:2
+30 SET DIE="^FBAAA("_FBVET_",1,"
SET FBAUTHF=+$PIECE(FBUCA,U,13)
IF FBAUTHF
SET Y=$$FILE^FBUCUTL(DIE,FBAUTHF,0,FBVET)
if +Y'>0
QUIT
SET (FBAIEN,FBIEN)=+Y
SET DA=FBVET
SET DR="[FB UNAUTHORIZED UPDATE]"
SET DIE="^FBAAA("
+31 ;S:$D(DTOUT) FBOUT=1 I 'FBOUT D UPDATE1(FBAIEN,FBDA)
IF FBAUTHF
DO LOCK^FBUCUTL(DIE,FBVET,1)
IF FBLOCK
DO ^DIE
LOCK -^FBAAA(FBVET)
KILL DA,DIE,DQ,DR,FBLOCK
DO UPDATE1(FBAIEN,FBDA)
End DoDot:1
AUTHQ KILL DA,DIC,DIE,DQ,DR,DTOUT,DUOUT,FBDCHG,X,Y
QUIT
UPDATE ;update if there is a change - keeps 583 and authorization in sync
+1 NEW DA,DIE,DR,FBLOCK
+2 SET DA=FBVET
SET DR="[FB UNAUTHORIZED UPDATE1]"
SET DIE="^FBAAA("
+3 DO LOCK^FBUCUTL(DIE,FBVET,1)
IF FBLOCK
DO ^DIE
LOCK -^FBAAA(FBVET)
+4 QUIT
UPDATE1(FBAIEN,FBIEN) ;update authorization field (# 30) for unauthorized claim
+1 ;INPUT: FBAIEN = internal entry number of authorization (could be '@' for deletion
+2 ; FBIEN = internal entry number of u/c (may be fbda)
+3 ; FBALL = flag to update all other claims (1=update all)
+4 ;OUTPUT: update field 30 (AUTHORIZAITION) to value of fbaien
+5 NEW DA,DIE,DR,FBLOCK
IF $SELECT(+$GET(FBAIEN)'>0&(FBAIEN'="@"):1,'+$GET(FBIEN):1,FBAIEN'?1N.N&(FBAIEN'="@"):1,1:0)
QUIT
+6 SET DA=FBIEN
SET DIE="^FB583("
SET DR="S:FBAIEN=""@"" Y=""@1"";30////^S X=FBAIEN;S Y=""@99"";@1;30///@;@99"
DO LOCK^FBUCUTL(DIE,DA,1)
IF FBLOCK
DO ^DIE
LOCK -^FB583(FBIEN)
+7 QUIT
