- 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 Jan 18, 2025@03:01:21 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