FBUCED ;ALBISC/TET - EDIT UNAUTHORIZED CLAIM FILES ;10/07/2014
;;3.5;FEE BASIS;**32,38,154,174**;JAN 30, 1995;Build 1
;;Per VA Directive 6402, this routine should not be modified.
EDT ;edit unauthorized claim with order less than 40 (not dispositioned
;or order = 40 if action is reopen (called by REO tag)
S:'$D(FBACT) FBACT="EDT" S FBO=$S(FBACT="EDT":"5^10^20^30^",1:"40^")
D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED EDIT]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
G END Q
REO ;reopen a dispositioned claim (order of 40)
S FBACT="REO" G EDT
Q
APL ;appeal a dispostioned claim (order of 40)
S FBACT="APL",FBO="40^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED APPEAL]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
G END Q
AED ;edit an appeal to an unauthorized claim
S FBACT="AED",FBO="50^55^60^70^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED APPEAL EDIT]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
G END Q
COVA ;enter/edit a COVA appeal
S FBACT="COVA",FBO="70^80^90^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED COVA APPEAL]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
G END Q
DIS ;disposition an appeal
S FBACT="DIS",FBO=0 D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED DISPOSITION]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
G END Q
REC ;receive information which was requested
S FBACT="REC",FBO="5^10^50^55^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT,+$G(FBARY) H:+FBARY=1 1 D EDIT8
G END
REQ ;request information
S FBACT="REQ",FBO="5^10^20^30^50^55^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT,+$G(FBARY) D EDIT8
G:$G(FBOUT) END D END W !! G REQ
LET ;to update date letter printed without printing letter
N FBLETDT D DISPNP^FBUCUTL3 ;set array of letters which are waiting to be printed
D DISPX^FBUCUTL1(1) ;display array for selection
I 'FBOUT,+$G(FBARY) D LETDATE^FBUCUTL3 I 'FBOUT D
.N FBDA,FBEXP,FBI,FBLET,FBNODE,FBPL,FBUCA D PARSE^FBUCUTL4(FBARY) S FBI=0,FBLET="@" S FBLETDT=$S('+FBLETDT:DT,1:FBLETDT)
.F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI S FBNODE=$G(^(FBI)),FBDA=+FBNODE,FBUCA=$G(^FB583(FBDA,0)),FBEXP=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,$$ORDER^FBUCUTL($P(FBUCA,U,24))) D EDITL(FBDA,FBEXP,FBLET,FBLETDT)
G END
EXT ;enter extensions for incomplete Mill Bill claims
;
; select mill bill claim(s) with an appropriate status
S FBACT="EXT",FBO="5^10^" D LOOKUP^FBUCUTL3(FBO,,"M")
Q:'+$G(FBARY)!FBOUT
N FBDA,FBI,FBNODE,FBPL,FBW
D PARSE^FBUCUTL4(FBARY)
;
; loop through all selected claims
S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI D Q:FBOUT
. S FBNODE=$G(^TMP("FBARY",$J,FBI))
. S FBDA=+$P(FBNODE,";")
. N DA,DIE,DIR,DR,FBEXP,FBEXT,FBEXTD,FBUCA,FBY,Y
. ; if more than one claim selected then display current one
. I +$G(FBARY)>1 D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
. ; lock claim
. D LOCK^FBUCUTL("^FB583(",FBDA) Q:'FBLOCK
. ;
. S FBUCA=$G(^FB583(FBDA,0))
. ;
. ; get current expiration date (if any)
. S FBEXP=$P(FBUCA,U,26)
. ;
. ; get most recent extension (if any)
. S FBEXT=$$EXT^FBUCUTL8(FBDA,10)
. I FBEXT W !,"Current extension date is "_$$FMTE^XLFDT($P(FBEXT,U,2))
. ;
. ; prompt for new extension date
. S FBEXTD="" F D Q:FBEXTD]""!FBOUT
. . K DA
. . I FBEXT S DA(1)=FBDA,DA=+FBEXT ; use existing value as the default
. . S DIR(0)="162.701,.04"
. . D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
. . S FBEXTD=Y
. . ; confirm
. . S DIR(0)="Y"
. . S DIR("A")="Confirm entry of "_$$FMTE^XLFDT(FBEXTD)_" as the new extension date for the claim"
. . D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
. . I 'Y S FBEXTD="" ; prompt again
. . I FBEXTD=$P(FBEXT,U,2) W !,"New extension date is equal to existing extension date. No change made." S FBEXTD=0
. ;
. I FBEXTD,'FBOUT D
. . ; save extension
. . K DA,DD,DO,DIC,DIE
. . S DA(1)=FBDA
. . S DIC="^FB583(DA(1),3,",DIC(0)="L",X=$$NOW^XLFDT()
. . S DIC("DR")=".02////^S X=DUZ;.03///INCOMPLETE UNAUTHORIZED CLAIM;.04///^S X=FBEXTD"
. . D FILE^DICN I Y'>0 W !,"ERROR ADDING EXTENSION" Q
. . S DA=+Y
. . ;
. . ; prompt for optional comments
. . S DIE="^FB583(DA(1),3,",DR=".05" D ^DIE
. . ;
. . ; recompute expiration date if one already exists and update claim
. . I FBEXP D
. . . N FBLETDT,FBORDER
. . . S FBLETDT=$P(FBUCA,U,19)
. . . S FBORDER=$$ORDER^FBUCUTL($P(FBUCA,U,24))
. . . S FBEXP=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,FBORDER)
. . . D EDITL^FBUCED(FBDA,FBEXP)
. ;
. ; unlock claim
. L -^FB583(FBDA)
;
G END
REQENT ;enter/edit requested information file, 162.93
S DLAYGO=162.93,DIC(0)="AELMQZ",DIC="^FB(162.93," D ^DIC K DLAYGO I +Y>0 S DIE=DIC,DA=+Y,FBDA=DA,DR=".01:1" D LOCK^FBUCUTL(DIE,FBDA,0) I FBLOCK D ^DIE L -^FB(162.93,FBDA) K DIE,DE,DA,DQ,DR,FBDA,FBLOCK W ! G REQENT
G END
DISENT ;enter/edit disapproval reasons file 162.94
S DLAYGO=162.94,DIC(0)="AELMQZ",DIC="^FB(162.94," D ^DIC K DLAYGO I +Y>0 S DIE=DIC,DA=+Y,FBDA=DA,DR=".01:1" D LOCK^FBUCUTL(DIE,FBDA,0) I FBLOCK D ^DIE L -^FB(162.94,FBDA) K DIE,DE,DA,DQ,DR,FBDA,FBLOCK W ! G DISENT
G END
DSPENT ;edit disposition file 162.91
S DIC(0)="AEMQZ",DIC="^FB(162.91," D ^DIC I +Y>0 S DIE=DIC,DA=+Y,FBDA=DA,DR="1:3" D LOCK^FBUCUTL(DIE,FBDA,0) I FBLOCK D ^DIE L -^FB(162.91,FBDA) K DIE,DE,DA,DQ,DR,FBDA,FBLOCK W ! G DSPENT
END ;kill and quit
K DA,DE,DIC,DIE,DQ,DR,DTOUT,DUOUT,FBACT,FBAR,FBARY,FBDR,FBIEN,FBIX,FBLOCK,FBO,FBOUT,FBUCPDX,X,Y,FBPROG ;add FBPROG - FB*3*174
K ^TMP("FBAR",$J),^TMP("FBARY",$J),^TMP("FBPARY",$J) Q
EDIT8 ;edit file 162.8, call before/after & update
N FBDA,FBI,FBNODE,FBP,FBPL,FBUCA,FBUCAA,FBUCP,FBUCPA,FBW D PARSE^FBUCUTL4(FBARY) S %X="^TMP(""FBARY"",$J,",%Y="^TMP(""FBPARY"",$J," D %XY^%RCR K %X,%Y
S FBI=0 F S FBI=$O(^TMP("FBPARY",$J,FBI)) Q:'FBI S FBNODE=$G(^(FBI)),FBDA=+FBNODE,FBNODE=$P(FBNODE,";",2) D G:FBOUT END
.I +$G(FBPARY)>1 W !! F FBP=1:1:FBPL W ?($P(FBW,U,FBP)),$P(FBNODE,U,FBP)
.D PRIOR^FBUCEVT(FBDA,FBACT)
.N FBARY D REQ^FBUCPEND:FBACT="REQ",REC^FBUCPEND:FBACT="REC" Q:FBOUT D FREQ^FBUCPEND:FBACT="REQ",FREC^FBUCPEND:FBACT="REC"
.D AFTER^FBUCEVT(FBDA,FBACT),UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
Q
EDITL(FBDA,FBEXP,FBLET,FBLETDT,FBTAMT) ;edit letter sent info,
;may be called to just update expiration, or update print flag, date letter sent &/or expiration, or amount approved
;INPUT: FBDA = ien of unauthorized claim (# 162.7)
; FBEXP = expiration date (optional)
; FBLET = flag for letter printed (optional)
; FBLETDT = date letter sent (optional)
; FBLET = '@' to delete letter flag
; FBEXP = expiration date or 0
; FBTAMT = amount approved (optional)
;OUTPUT: nothing - update all or some flds in 162.7: 19,19.5,26,14
Q:'+$G(FBDA)
S FBEXP=+$G(FBEXP),FBLET=$G(FBLET),FBLETDT=+$G(FBLETDT)
S FBTAMT=$G(FBTAMT)
I 'FBEXP,FBLET']"",'FBLETDT,FBTAMT']"" Q
N FBLOCK,DIE,DA,DR
S DIE="^FB583(",DR="[FB UNAUTHORIZED LETTER UPDATE]",DA=FBDA
D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(FBDA) K FBLOCK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBUCED 7015 printed Apr 09, 2024@21:04:33 Page 2
FBUCED ;ALBISC/TET - EDIT UNAUTHORIZED CLAIM FILES ;10/07/2014
+1 ;;3.5;FEE BASIS;**32,38,154,174**;JAN 30, 1995;Build 1
+2 ;;Per VA Directive 6402, this routine should not be modified.
EDT ;edit unauthorized claim with order less than 40 (not dispositioned
+1 ;or order = 40 if action is reopen (called by REO tag)
+2 if '$DATA(FBACT)
SET FBACT="EDT"
SET FBO=$SELECT(FBACT="EDT":"5^10^20^30^",1:"40^")
+3 DO LOOKUP^FBUCUTL3(FBO)
IF 'FBOUT
SET FBDR="[FB UNAUTHORIZED EDIT]"
DO EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
+4 GOTO END
QUIT
REO ;reopen a dispositioned claim (order of 40)
+1 SET FBACT="REO"
GOTO EDT
+2 QUIT
APL ;appeal a dispostioned claim (order of 40)
+1 SET FBACT="APL"
SET FBO="40^"
DO LOOKUP^FBUCUTL3(FBO)
IF 'FBOUT
SET FBDR="[FB UNAUTHORIZED APPEAL]"
DO EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
+2 GOTO END
QUIT
AED ;edit an appeal to an unauthorized claim
+1 SET FBACT="AED"
SET FBO="50^55^60^70^"
DO LOOKUP^FBUCUTL3(FBO)
IF 'FBOUT
SET FBDR="[FB UNAUTHORIZED APPEAL EDIT]"
DO EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
+2 GOTO END
QUIT
COVA ;enter/edit a COVA appeal
+1 SET FBACT="COVA"
SET FBO="70^80^90^"
DO LOOKUP^FBUCUTL3(FBO)
IF 'FBOUT
SET FBDR="[FB UNAUTHORIZED COVA APPEAL]"
DO EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
+2 GOTO END
QUIT
DIS ;disposition an appeal
+1 SET FBACT="DIS"
SET FBO=0
DO LOOKUP^FBUCUTL3(FBO)
IF 'FBOUT
SET FBDR="[FB UNAUTHORIZED DISPOSITION]"
DO EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
+2 GOTO END
QUIT
REC ;receive information which was requested
+1 SET FBACT="REC"
SET FBO="5^10^50^55^"
DO LOOKUP^FBUCUTL3(FBO)
IF 'FBOUT
IF +$GET(FBARY)
if +FBARY=1
HANG 1
DO EDIT8
+2 GOTO END
REQ ;request information
+1 SET FBACT="REQ"
SET FBO="5^10^20^30^50^55^"
DO LOOKUP^FBUCUTL3(FBO)
IF 'FBOUT
IF +$GET(FBARY)
DO EDIT8
+2 if $GET(FBOUT)
GOTO END
DO END
WRITE !!
GOTO REQ
LET ;to update date letter printed without printing letter
+1 ;set array of letters which are waiting to be printed
NEW FBLETDT
DO DISPNP^FBUCUTL3
+2 ;display array for selection
DO DISPX^FBUCUTL1(1)
+3 IF 'FBOUT
IF +$GET(FBARY)
DO LETDATE^FBUCUTL3
IF 'FBOUT
Begin DoDot:1
+4 NEW FBDA,FBEXP,FBI,FBLET,FBNODE,FBPL,FBUCA
DO PARSE^FBUCUTL4(FBARY)
SET FBI=0
SET FBLET="@"
SET FBLETDT=$SELECT('+FBLETDT:DT,1:FBLETDT)
+5 FOR
SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
if 'FBI
QUIT
SET FBNODE=$GET(^(FBI))
SET FBDA=+FBNODE
SET FBUCA=$GET(^FB583(FBDA,0))
SET FBEXP=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,$$ORDER^FBUCUTL($PIECE(FBUCA,U,24)))
DO EDITL(FBDA,FBEXP,FBLET,FBLETDT)
End DoDot:1
+6 GOTO END
EXT ;enter extensions for incomplete Mill Bill claims
+1 ;
+2 ; select mill bill claim(s) with an appropriate status
+3 SET FBACT="EXT"
SET FBO="5^10^"
DO LOOKUP^FBUCUTL3(FBO,,"M")
+4 if '+$GET(FBARY)!FBOUT
QUIT
+5 NEW FBDA,FBI,FBNODE,FBPL,FBW
+6 DO PARSE^FBUCUTL4(FBARY)
+7 ;
+8 ; loop through all selected claims
+9 SET FBI=0
FOR
SET FBI=$ORDER(^TMP("FBARY",$JOB,FBI))
if 'FBI
QUIT
Begin DoDot:1
+10 SET FBNODE=$GET(^TMP("FBARY",$JOB,FBI))
+11 SET FBDA=+$PIECE(FBNODE,";")
+12 NEW DA,DIE,DIR,DR,FBEXP,FBEXT,FBEXTD,FBUCA,FBY,Y
+13 ; if more than one claim selected then display current one
+14 IF +$GET(FBARY)>1
DO LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
+15 ; lock claim
+16 DO LOCK^FBUCUTL("^FB583(",FBDA)
if 'FBLOCK
QUIT
+17 ;
+18 SET FBUCA=$GET(^FB583(FBDA,0))
+19 ;
+20 ; get current expiration date (if any)
+21 SET FBEXP=$PIECE(FBUCA,U,26)
+22 ;
+23 ; get most recent extension (if any)
+24 SET FBEXT=$$EXT^FBUCUTL8(FBDA,10)
+25 IF FBEXT
WRITE !,"Current extension date is "_$$FMTE^XLFDT($PIECE(FBEXT,U,2))
+26 ;
+27 ; prompt for new extension date
+28 SET FBEXTD=""
FOR
Begin DoDot:2
+29 KILL DA
+30 ; use existing value as the default
IF FBEXT
SET DA(1)=FBDA
SET DA=+FBEXT
+31 SET DIR(0)="162.701,.04"
+32 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBOUT=1
QUIT
+33 SET FBEXTD=Y
+34 ; confirm
+35 SET DIR(0)="Y"
+36 SET DIR("A")="Confirm entry of "_$$FMTE^XLFDT(FBEXTD)_" as the new extension date for the claim"
+37 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET FBOUT=1
QUIT
+38 ; prompt again
IF 'Y
SET FBEXTD=""
+39 IF FBEXTD=$PIECE(FBEXT,U,2)
WRITE !,"New extension date is equal to existing extension date. No change made."
SET FBEXTD=0
End DoDot:2
if FBEXTD]""!FBOUT
QUIT
+40 ;
+41 IF FBEXTD
IF 'FBOUT
Begin DoDot:2
+42 ; save extension
+43 KILL DA,DD,DO,DIC,DIE
+44 SET DA(1)=FBDA
+45 SET DIC="^FB583(DA(1),3,"
SET DIC(0)="L"
SET X=$$NOW^XLFDT()
+46 SET DIC("DR")=".02////^S X=DUZ;.03///INCOMPLETE UNAUTHORIZED CLAIM;.04///^S X=FBEXTD"
+47 DO FILE^DICN
IF Y'>0
WRITE !,"ERROR ADDING EXTENSION"
QUIT
+48 SET DA=+Y
+49 ;
+50 ; prompt for optional comments
+51 SET DIE="^FB583(DA(1),3,"
SET DR=".05"
DO ^DIE
+52 ;
+53 ; recompute expiration date if one already exists and update claim
+54 IF FBEXP
Begin DoDot:3
+55 NEW FBLETDT,FBORDER
+56 SET FBLETDT=$PIECE(FBUCA,U,19)
+57 SET FBORDER=$$ORDER^FBUCUTL($PIECE(FBUCA,U,24))
+58 SET FBEXP=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,FBORDER)
+59 DO EDITL^FBUCED(FBDA,FBEXP)
End DoDot:3
End DoDot:2
+60 ;
+61 ; unlock claim
+62 LOCK -^FB583(FBDA)
End DoDot:1
if FBOUT
QUIT
+63 ;
+64 GOTO END
REQENT ;enter/edit requested information file, 162.93
+1 SET DLAYGO=162.93
SET DIC(0)="AELMQZ"
SET DIC="^FB(162.93,"
DO ^DIC
KILL DLAYGO
IF +Y>0
SET DIE=DIC
SET DA=+Y
SET FBDA=DA
SET DR=".01:1"
DO LOCK^FBUCUTL(DIE,FBDA,0)
IF FBLOCK
DO ^DIE
LOCK -^FB(162.93,FBDA)
KILL DIE,DE,DA,DQ,DR,FBDA,FBLOCK
WRITE !
GOTO REQENT
+2 GOTO END
DISENT ;enter/edit disapproval reasons file 162.94
+1 SET DLAYGO=162.94
SET DIC(0)="AELMQZ"
SET DIC="^FB(162.94,"
DO ^DIC
KILL DLAYGO
IF +Y>0
SET DIE=DIC
SET DA=+Y
SET FBDA=DA
SET DR=".01:1"
DO LOCK^FBUCUTL(DIE,FBDA,0)
IF FBLOCK
DO ^DIE
LOCK -^FB(162.94,FBDA)
KILL DIE,DE,DA,DQ,DR,FBDA,FBLOCK
WRITE !
GOTO DISENT
+2 GOTO END
DSPENT ;edit disposition file 162.91
+1 SET DIC(0)="AEMQZ"
SET DIC="^FB(162.91,"
DO ^DIC
IF +Y>0
SET DIE=DIC
SET DA=+Y
SET FBDA=DA
SET DR="1:3"
DO LOCK^FBUCUTL(DIE,FBDA,0)
IF FBLOCK
DO ^DIE
LOCK -^FB(162.91,FBDA)
KILL DIE,DE,DA,DQ,DR,FBDA,FBLOCK
WRITE !
GOTO DSPENT
END ;kill and quit
+1 ;add FBPROG - FB*3*174
KILL DA,DE,DIC,DIE,DQ,DR,DTOUT,DUOUT,FBACT,FBAR,FBARY,FBDR,FBIEN,FBIX,FBLOCK,FBO,FBOUT,FBUCPDX,X,Y,FBPROG
+2 KILL ^TMP("FBAR",$JOB),^TMP("FBARY",$JOB),^TMP("FBPARY",$JOB)
QUIT
EDIT8 ;edit file 162.8, call before/after & update
+1 NEW FBDA,FBI,FBNODE,FBP,FBPL,FBUCA,FBUCAA,FBUCP,FBUCPA,FBW
DO PARSE^FBUCUTL4(FBARY)
SET %X="^TMP(""FBARY"",$J,"
SET %Y="^TMP(""FBPARY"",$J,"
DO %XY^%RCR
KILL %X,%Y
+2 SET FBI=0
FOR
SET FBI=$ORDER(^TMP("FBPARY",$JOB,FBI))
if 'FBI
QUIT
SET FBNODE=$GET(^(FBI))
SET FBDA=+FBNODE
SET FBNODE=$PIECE(FBNODE,";",2)
Begin DoDot:1
+3 IF +$GET(FBPARY)>1
WRITE !!
FOR FBP=1:1:FBPL
WRITE ?($PIECE(FBW,U,FBP)),$PIECE(FBNODE,U,FBP)
+4 DO PRIOR^FBUCEVT(FBDA,FBACT)
+5 NEW FBARY
if FBACT="REQ"
DO REQ^FBUCPEND
if FBACT="REC"
DO REC^FBUCPEND
if FBOUT
QUIT
if FBACT="REQ"
DO FREQ^FBUCPEND
if FBACT="REC"
DO FREC^FBUCPEND
+6 DO AFTER^FBUCEVT(FBDA,FBACT)
DO UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
End DoDot:1
if FBOUT
GOTO END
+7 QUIT
EDITL(FBDA,FBEXP,FBLET,FBLETDT,FBTAMT) ;edit letter sent info,
+1 ;may be called to just update expiration, or update print flag, date letter sent &/or expiration, or amount approved
+2 ;INPUT: FBDA = ien of unauthorized claim (# 162.7)
+3 ; FBEXP = expiration date (optional)
+4 ; FBLET = flag for letter printed (optional)
+5 ; FBLETDT = date letter sent (optional)
+6 ; FBLET = '@' to delete letter flag
+7 ; FBEXP = expiration date or 0
+8 ; FBTAMT = amount approved (optional)
+9 ;OUTPUT: nothing - update all or some flds in 162.7: 19,19.5,26,14
+10 if '+$GET(FBDA)
QUIT
+11 SET FBEXP=+$GET(FBEXP)
SET FBLET=$GET(FBLET)
SET FBLETDT=+$GET(FBLETDT)
+12 SET FBTAMT=$GET(FBTAMT)
+13 IF 'FBEXP
IF FBLET']""
IF 'FBLETDT
IF FBTAMT']""
QUIT
+14 NEW FBLOCK,DIE,DA,DR
+15 SET DIE="^FB583("
SET DR="[FB UNAUTHORIZED LETTER UPDATE]"
SET DA=FBDA
+16 DO LOCK^FBUCUTL(DIE,DA,1)
IF FBLOCK
DO ^DIE
LOCK -^FB583(FBDA)
KILL FBLOCK
+17 QUIT
