source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCED.m@ 893

Last change on this file since 893 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 6.7 KB
RevLine 
[613]1FBUCED ;ALBISC/TET - EDIT UNAUTHORIZED CLAIM FILES ;10/16/2001
2 ;;3.5;FEE BASIS;**32,38**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EDT ;edit unauthorized claim with order less than 40 (not dispositioned
5 ;or order = 40 if action is reopen (called by REO tag)
6 S:'$D(FBACT) FBACT="EDT" S FBO=$S(FBACT="EDT":"5^10^20^30^",1:"40^")
7 D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED EDIT]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
8 G END Q
9REO ;reopen a dispositioned claim (order of 40)
10 S FBACT="REO" G EDT
11 Q
12APL ;appeal a dispostioned claim (order of 40)
13 S FBACT="APL",FBO="40^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED APPEAL]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
14 G END Q
15AED ;edit an appeal to an unauthorized claim
16 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)
17 G END Q
18COVA ;enter/edit a COVA appeal
19 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)
20 G END Q
21DIS ;disposition an appeal
22 S FBACT="DIS",FBO=0 D LOOKUP^FBUCUTL3(FBO) I 'FBOUT S FBDR="[FB UNAUTHORIZED DISPOSITION]" D EDIT^FBUCED0(FBDR,FBACT,.FBOUT,FBARY)
23 G END Q
24REC ;receive information which was requested
25 S FBACT="REC",FBO="5^10^50^55^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT,+$G(FBARY) H:+FBARY=1 1 D EDIT8
26 G END
27REQ ;request information
28 S FBACT="REQ",FBO="5^10^20^30^50^55^" D LOOKUP^FBUCUTL3(FBO) I 'FBOUT,+$G(FBARY) D EDIT8
29 G:$G(FBOUT) END D END W !! G REQ
30LET ;to update date letter printed without printing letter
31 N FBLETDT D DISPNP^FBUCUTL3 ;set array of letters which are waiting to be printed
32 D DISPX^FBUCUTL1(1) ;display array for selection
33 I 'FBOUT,+$G(FBARY) D LETDATE^FBUCUTL3 I 'FBOUT D
34 .N FBDA,FBEXP,FBI,FBLET,FBNODE,FBPL,FBUCA D PARSE^FBUCUTL4(FBARY) S FBI=0,FBLET="@" S FBLETDT=$S('+FBLETDT:DT,1:FBLETDT)
35 .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)
36 G END
37EXT ;enter extensions for incomplete Mill Bill claims
38 ;
39 ; select mill bill claim(s) with an appropriate status
40 S FBACT="EXT",FBO="5^10^" D LOOKUP^FBUCUTL3(FBO,,"M")
41 Q:'+$G(FBARY)!FBOUT
42 N FBDA,FBI,FBNODE,FBPL,FBW
43 D PARSE^FBUCUTL4(FBARY)
44 ;
45 ; loop through all selected claims
46 S FBI=0 F S FBI=$O(^TMP("FBARY",$J,FBI)) Q:'FBI D Q:FBOUT
47 . S FBNODE=$G(^TMP("FBARY",$J,FBI))
48 . S FBDA=+$P(FBNODE,";")
49 . N DA,DIE,DIR,DR,FBEXP,FBEXT,FBEXTD,FBUCA,FBY,Y
50 . ; if more than one claim selected then display current one
51 . I +$G(FBARY)>1 D LINE^FBUCUTL4(FBNODE,FBI,FBPL,FBW)
52 . ; lock claim
53 . D LOCK^FBUCUTL("^FB583(",FBDA) Q:'FBLOCK
54 . ;
55 . S FBUCA=$G(^FB583(FBDA,0))
56 . ;
57 . ; get current expiration date (if any)
58 . S FBEXP=$P(FBUCA,U,26)
59 . ;
60 . ; get most recent extension (if any)
61 . S FBEXT=$$EXT^FBUCUTL8(FBDA,10)
62 . I FBEXT W !,"Current extension date is "_$$FMTE^XLFDT($P(FBEXT,U,2))
63 . ;
64 . ; prompt for new extension date
65 . S FBEXTD="" F D Q:FBEXTD]""!FBOUT
66 . . K DA
67 . . I FBEXT S DA(1)=FBDA,DA=+FBEXT ; use existing value as the default
68 . . S DIR(0)="162.701,.04"
69 . . D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
70 . . S FBEXTD=Y
71 . . ; confirm
72 . . S DIR(0)="Y"
73 . . S DIR("A")="Confirm entry of "_$$FMTE^XLFDT(FBEXTD)_" as the new extension date for the claim"
74 . . D ^DIR K DIR I $D(DIRUT) S FBOUT=1 Q
75 . . I 'Y S FBEXTD="" ; prompt again
76 . . I FBEXTD=$P(FBEXT,U,2) W !,"New extension date is equal to existing extension date. No change made." S FBEXTD=0
77 . ;
78 . I FBEXTD,'FBOUT D
79 . . ; save extension
80 . . K DA,DD,DO,DIC,DIE
81 . . S DA(1)=FBDA
82 . . S DIC="^FB583(DA(1),3,",DIC(0)="L",X=$$NOW^XLFDT()
83 . . S DIC("DR")=".02////^S X=DUZ;.03///INCOMPLETE UNAUTHORIZED CLAIM;.04///^S X=FBEXTD"
84 . . D FILE^DICN I Y'>0 W !,"ERROR ADDING EXTENSION" Q
85 . . S DA=+Y
86 . . ;
87 . . ; prompt for optional comments
88 . . S DIE="^FB583(DA(1),3,",DR=".05" D ^DIE
89 . . ;
90 . . ; recompute expiration date if one already exists and update claim
91 . . I FBEXP D
92 . . . N FBLETDT,FBORDER
93 . . . S FBLETDT=$P(FBUCA,U,19)
94 . . . S FBORDER=$$ORDER^FBUCUTL($P(FBUCA,U,24))
95 . . . S FBEXP=$$EXPIRE^FBUCUTL8(FBDA,FBLETDT,FBUCA,FBORDER)
96 . . . D EDITL^FBUCED(FBDA,FBEXP)
97 . ;
98 . ; unlock claim
99 . L -^FB583(FBDA)
100 ;
101 G END
102REQENT ;enter/edit requested information file, 162.93
103 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
104 G END
105DISENT ;enter/edit disapproval reasons file 162.94
106 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
107 G END
108DSPENT ;edit disposition file 162.91
109 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
110END ;kill and quit
111 K DA,DE,DIC,DIE,DQ,DR,DTOUT,DUOUT,FBACT,FBAR,FBARY,FBDR,FBIEN,FBIX,FBLOCK,FBO,FBOUT,FBUCPDX,X,Y
112 K ^TMP("FBAR",$J),^TMP("FBARY",$J),^TMP("FBPARY",$J) Q
113EDIT8 ;edit file 162.8, call before/after & update
114 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
115 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
116 .I +$G(FBPARY)>1 W !! F FBP=1:1:FBPL W ?($P(FBW,U,FBP)),$P(FBNODE,U,FBP)
117 .D PRIOR^FBUCEVT(FBDA,FBACT)
118 .N FBARY D REQ^FBUCPEND:FBACT="REQ",REC^FBUCPEND:FBACT="REC" Q:FBOUT D FREQ^FBUCPEND:FBACT="REQ",FREC^FBUCPEND:FBACT="REC"
119 .D AFTER^FBUCEVT(FBDA,FBACT),^FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT)
120 Q
121EDITL(FBDA,FBEXP,FBLET,FBLETDT,FBTAMT) ;edit letter sent info,
122 ;may be called to just update expiration, or update print flag, date letter sent &/or expiration, or amount approved
123 ;INPUT: FBDA = ien of unauthorized claim (# 162.7)
124 ; FBEXP = expiration date (optional)
125 ; FBLET = flag for letter printed (optional)
126 ; FBLETDT = date letter sent (optional)
127 ; FBLET = '@' to delete letter flag
128 ; FBEXP = expiration date or 0
129 ; FBTAMT = amount approved (optional)
130 ;OUTPUT: nothing - update all or some flds in 162.7: 19,19.5,26,14
131 Q:'+$G(FBDA)
132 S FBEXP=+$G(FBEXP),FBLET=$G(FBLET),FBLETDT=+$G(FBLETDT)
133 S FBTAMT=$G(FBTAMT)
134 I 'FBEXP,FBLET']"",'FBLETDT,FBTAMT']"" Q
135 N FBLOCK,DIE,DA,DR
136 S DIE="^FB583(",DR="[FB UNAUTHORIZED LETTER UPDATE]",DA=FBDA
137 D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FB583(FBDA) K FBLOCK
138 Q
Note: See TracBrowser for help on using the repository browser.