- 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 Apr 23, 2025@18:14:58 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
