Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBUCED

FBUCED.m

Go to the documentation of this file.
  1. FBUCED ;ALBISC/TET - EDIT UNAUTHORIZED CLAIM FILES ;10/07/2014
  1. ;;3.5;FEE BASIS;**32,38,154,174**;JAN 30, 1995;Build 1
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. EDT ;edit unauthorized claim with order less than 40 (not dispositioned
  1. ;or order = 40 if action is reopen (called by REO tag)
  1. S:'$D(FBACT) FBACT="EDT" S FBO=$S(FBACT="EDT":"5^10^20^30^",1:"40^")
  1. D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED EDIT]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
  1. G END Q
  1. REO ;reopen a dispositioned claim (order of 40)
  1. S FBACT="REO" G EDT
  1. Q
  1. APL ;appeal a dispostioned claim (order of 40)
  1. S FBACT="APL",FBO="40^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED APPEAL]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
  1. G END Q
  1. AED ;edit an appeal to an unauthorized claim
  1. 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)
  1. G END Q
  1. COVA ;enter/edit a COVA appeal
  1. 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)
  1. G END Q
  1. DIS ;disposition an appeal
  1. S FBACT="DIS",FBO=0 D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED DISPOSITION]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
  1. G END Q
  1. REC ;receive information which was requested
  1. S FBACT="REC",FBO="5^10^50^55^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT,+$G(FBARY) H:+FBARY=1 1 D EDIT8
  1. G END
  1. REQ ;request information
  1. S FBACT="REQ",FBO="5^10^20^30^50^55^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT,+$G(FBARY) D EDIT8
  1. G:$G(FBOUT) END D END W !! G REQ
  1. LET ;to update date letter printed without printing letter
  1. N FBLETDT D DISPNP^FBUCUTL3 ;set array of letters which are waiting to be printed
  1. D DISPX^FBUCUTL1(1) ;display array for selection
  1. I 'FBOUT,+$G(FBARY) D LETDATE^FBUCUTL3 I 'FBOUT D
  1. .N FBDA,FBEXP,FBI,FBLET,FBNODE,FBPL,FBUCA D PARSE^FBUCUTL4(FBARY) S FBI=0,FBLET="@" S FBLETDT=$S('+FBLETDT:DT,1:FBLETDT)
  1. .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)
  1. G END
  1. EXT ;enter extensions for incomplete Mill Bill claims
  1. ;
  1. ; select mill bill claim(s) with an appropriate status
  1. S FBACT="EXT",FBO="5^10^" D LOOKUP^FBUCUTL3(FBO,,"M")
  1. Q:'+$G(FBARY)!FBOUT
  1. N FBDA,FBI,FBNODE,FBPL,FBW
  1. D PARSE^FBUCUTL4(FBARY)
  1. ;
  1. ; loop through all selected claims
  1. S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI D Q:FBOUT
  1. . S FBNODE=$G(^TMP("FBARY",$J,FBI))
  1. . S FBDA=+$P(FBNODE,";")
  1. . N DA,DIE,DIR,DR,FBEXP,FBEXT,FBEXTD,FBUCA,FBY,Y
  1. . ; if more than one claim selected then display current one
  1. . I +$G(FBARY)>1 D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
  1. . ; lock claim
  1. . D LOCK^FBUCUTL("^FB583(",FBDA) Q:'FBLOCK
  1. . ;
  1. . S FBUCA=$G(^FB583(FBDA,0))
  1. . ;
  1. . ; get current expiration date (if any)
  1. . S FBEXP=$P(FBUCA,U,26)
  1. . ;
  1. . ; get most recent extension (if any)
  1. . S FBEXT=$$EXT^FBUCUTL8(FBDA,10)
  1. . I FBEXT W !,"Current extension date is "_$$FMTE^XLFDT($P(FBEXT,U,2))
  1. . ;
  1. . ; prompt for new extension date
  1. . S FBEXTD="" F D Q:FBEXTD]""!FBOUT
  1. . . K DA
  1. . . I FBEXT S DA(1)=FBDA,DA=+FBEXT ; use existing value as the default
  1. . . S DIR(0)="162.701,.04"
  1. . . D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
  1. . . S FBEXTD=Y
  1. . . ; confirm
  1. . . S DIR(0)="Y"
  1. . . S DIR("A")="Confirm entry of "_$$FMTE^XLFDT(FBEXTD)_" as the new extension date for the claim"
  1. . . D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
  1. . . I 'Y S FBEXTD="" ; prompt again
  1. . . I FBEXTD=$P(FBEXT,U,2) W !,"New extension date is equal to existing extension date. No change made." S FBEXTD=0
  1. . ;
  1. . I FBEXTD,'FBOUT D
  1. . . ; save extension
  1. . . K DA,DD,DO,DIC,DIE
  1. . . S DA(1)=FBDA
  1. . . S DIC="^FB583(DA(1),3,",DIC(0)="L",X=$$NOW^XLFDT()
  1. . . S DIC("DR")=".02////^S X=DUZ;.03///INCOMPLETE UNAUTHORIZED CLAIM;.04///^S X=FBEXTD"
  1. . . D FILE^DICN I Y'>0 W !,"ERROR ADDING EXTENSION" Q
  1. . . S DA=+Y
  1. . . ;
  1. . . ; prompt for optional comments
  1. . . S DIE="^FB583(DA(1),3,",DR=".05" D ^DIE
  1. . . ;
  1. . . ; recompute expiration date if one already exists and update claim
  1. . . I FBEXP D
  1. . . . N FBLETDT,FBORDER
  1. . . . S FBLETDT=$P(FBUCA,U,19)
  1. . . . S FBORDER=$$ORDER^FBUCUTL($P(FBUCA,U,24))
  1. . . . S FBEXP=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,FBORDER)
  1. . . . D EDITL^FBUCED(FBDA,FBEXP)
  1. . ;
  1. . ; unlock claim
  1. . L -^FB583(FBDA)
  1. ;
  1. G END
  1. REQENT ;enter/edit requested information file, 162.93
  1. 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
  1. G END
  1. DISENT ;enter/edit disapproval reasons file 162.94
  1. 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
  1. G END
  1. DSPENT ;edit disposition file 162.91
  1. 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
  1. END ;kill and quit
  1. 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
  1. K ^TMP("FBAR",$J),^TMP("FBARY",$J),^TMP("FBPARY",$J) Q
  1. EDIT8 ;edit file 162.8, call before/after & update
  1. 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
  1. 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
  1. .I +$G(FBPARY)>1 W !! F FBP=1:1:FBPL W ?($P(FBW,U,FBP)),$P(FBNODE,U,FBP)
  1. .D PRIOR^FBUCEVT(FBDA,FBACT)
  1. .N FBARY D REQ^FBUCPEND:FBACT="REQ",REC^FBUCPEND:FBACT="REC" Q:FBOUT D FREQ^FBUCPEND:FBACT="REQ",FREC^FBUCPEND:FBACT="REC"
  1. .D AFTER^FBUCEVT(FBDA,FBACT),UPDATE^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
  1. Q
  1. 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
  1. ;INPUT: FBDA = ien of unauthorized claim (# 162.7)
  1. ; FBEXP = expiration date (optional)
  1. ; FBLET = flag for letter printed (optional)
  1. ; FBLETDT = date letter sent (optional)
  1. ; FBLET = '@' to delete letter flag
  1. ; FBEXP = expiration date or 0
  1. ; FBTAMT = amount approved (optional)
  1. ;OUTPUT: nothing - update all or some flds in 162.7: 19,19.5,26,14
  1. Q:'+$G(FBDA)
  1. S FBEXP=+$G(FBEXP),FBLET=$G(FBLET),FBLETDT=+$G(FBLETDT)
  1. S FBTAMT=$G(FBTAMT)
  1. I 'FBEXP,FBLET']"",'FBLETDT,FBTAMT']"" Q
  1. N FBLOCK,DIE,DA,DR
  1. S DIE="^FB583(",DR="[FB UNAUTHORIZED LETTER UPDATE]",DA=FBDA
  1. D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(FBDA) K FBLOCK
  1. Q