85 lines
5.1 KiB
Mathematica
85 lines
5.1 KiB
Mathematica
FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT,FBUCDISR) ;ALBISC/TET - UPDATE AFTER EVENT ;11/15/01
|
|
;;3.5;FEE BASIS;**8,27,38**;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
UPDATE ;update if before and after values differ
|
|
;INPUT: FBUCP - zero node of 162.7, prior
|
|
; FBUCPA- 'A' (appeal) node of 162.7, prior
|
|
; FBUCA - zero node of 162.7, after
|
|
; FBUCAA- 'A' (appeal) node of 162.7, after
|
|
; FBDA - IEN of 162.7
|
|
; FBACT - action type
|
|
; FBUCDISR - (option) exists if disapp.
|
|
; 1 = denial reasons for gr to be same as prim
|
|
; 0 = ask denial reason for each claim in gr
|
|
;VARIABLES:
|
|
; FBSTATUS - 0 if no change, or status ien to 162.92
|
|
; FBORDER - order number of status in 162.92
|
|
; FBLET - = 1 if status or disp. changed (letter should be printed)
|
|
; FBDISP - flag if disp. changed to approved from other
|
|
; than approved. 1 to delete disap. reasons
|
|
; 0 no action
|
|
; FBDISPDT - date disp. changed, 0 if no change, "@" to delete
|
|
; FBEXP - exp. date, 0 if no change, "@" to delete
|
|
; or new date in internal format
|
|
; FBVALID - valid date claim rec., 0 if no change, "@" to delete
|
|
; or today's date in internal format
|
|
; FBORIG - date of original disp. or "@" to delete
|
|
; to approve. 1 is to set in file 161, 0 is to delete.
|
|
I $S('+$G(FBDA):1,$G(FBACT)']"":1,$G(FBUCA)']"":1,1:0) G END
|
|
AUTH ;determine if auth. needs to be updated, based upon disp.
|
|
;returns variable FBAUTH, may returne FBOUT
|
|
D AUTH^FBUCUPD1(FBUCP,FBUCA,FBDA,FBACT)
|
|
;
|
|
Q ;enter code to task remainder of update here
|
|
;S ZTRTN="DQ^FBUCUPD",ZTDESC="UPDATE UNAUTH CLAIM",ZTDTH=$H,ZTIO="",ZTSAVE("FBUCP")="",ZTSAVE("FBUCPA")="",ZTSAVE("FBUCA")="",ZTSAVE("FBUCAA")="",ZTSAVE("FBDA")="" S:$D(FBAUTH) ZTSAVE("FBAUTH")=""
|
|
;D ^%ZTLOAD G END
|
|
;
|
|
DQ ;de-queue tasked job here
|
|
D:$D(XRTL) T0^%ZOSV ;start monitor
|
|
N FBD1,FBD2,FBDISP,FBDISPDT,FBEXP,FBLET,FBORDER,FBORIG,FBST,FBSTATUS,FBUC,FBVALID S (FBDISP,FBDISPDT,FBEXP,FBLET,FBORDER,FBORIG,FBSTATUS,FBVALID)=0,FBUC=$$FBUC^FBUCUTL2(1)
|
|
;
|
|
STATUS ;determine status of claim
|
|
;FBST=status of claim prior to update;updated to most current
|
|
S FBST=$$ORDER^FBUCUTL(+$P(FBUCA,U,24)) I FBST<40 S FBST=$S($$PEND^FBUCUTL(FBDA):10,$P(FBUC,U,7)&(FBACT="ENT"):5,1:30)
|
|
;
|
|
DISP ;dispostion change
|
|
I $P(FBUCP,U,11)'=$P(FBUCA,U,11),$P(FBUCA,U,11) D
|
|
.S FBST=$S($P(FBUCAA,U,6):90,$P(FBUCAA,U,4):70,1:40)
|
|
.S FBDISPDT=DT,FBORIG=$S('$P(FBUCP,U,11)&(FBST=40):DT,1:0)
|
|
I $P(FBUCP,U,11)'=$P(FBUCA,U,11),'$P(FBUCA,U,11) D
|
|
.N FBO S FBO=$$ORDER^FBUCUTL(+$P(FBUCP,U,24))
|
|
.I FBO=90 S FBST=$S($P(FBUCAA,U,5):80,1:70)
|
|
.I FBO=70 S FBST=$S($P(FBUCAA,U,3):60,$P(FBUCAA,U,2):55,$P(FBUCAA,U):50,1:40)
|
|
.I FBO=40 S FBST=$S($$PEND^FBUCUTL(FBDA):10,1:30)
|
|
.S FBDISPDT="@",FBORIG=$S($$ORDER^FBUCUTL($P(FBUCP,U,24))=40:"@",1:0)
|
|
I $P(FBUCP,U,11)'=$P(FBUCA,U,11) S FBLET=1 S FBD1=$P(FBUCP,U,11),FBD2=$P(FBUCA,U,11) I "^2^3^5^"[FBD1,"^1^4^"[FBD2 S FBDISP=1
|
|
I $P(FBUCP,U,11)=$P(FBUCA,U,11),FBUCPA=FBUCAA S FBST=$S($P(FBUCA,U,11):40,1:FBST)
|
|
;
|
|
APPEAL ;appeal change - check if disposition remains unchanged
|
|
I FBUCAA]""!(FBUCPA'=FBUCAA) D
|
|
.I $P(FBUCAA,U,2)&($P(FBUCA,U,11)=5) S FBST=70 Q
|
|
.S FBST=$S('$P(FBUCAA,U):40,'$P(FBUCAA,U,2):50,'$P(FBUCAA,U,3):55,'$P(FBUCAA,U,4):60,'$P(FBUCAA,U,5):70,'$P(FBUCAA,U,6):80,$P(FBUCAA,U,6):90,$P(FBUCAA,U,5):80,$P(FBUCAA,U,4):70,$P(FBUCAA,U,3):60,$P(FBUCAA,U,2):55,$P(FBUCAA,U):50,1:FBST)
|
|
;
|
|
S FBORDER=FBST,FBSTATUS=$$STATUS^FBUCUTL(FBORDER) S:FBORIG]"" $P(FBUCA,U,22)=$S(FBORIG="@":"",FBORIG=0:"",1:FBORIG)
|
|
I FBSTATUS,FBSTATUS'=$P(FBUCA,U,24)!(FBUCP']"")!((FBORDER=10)&("^ENT^REQ^"[FBACT)) D
|
|
.S FBLET=$S(FBORDER=10:1,FBORDER=40&(FBACT="ENT"):1,FBORDER=$$ORDER^FBUCUTL(+$P(FBUCA,U,24)):0,1:1) I FBLET S FBLET=$S($$LETTER^FBUCUTL2(FBORDER):1,1:0)
|
|
.S FBVALID=$S(FBORDER>20&('$P(FBUCA,U,8))&('$$PEND^FBUCUTL(FBDA)):DT,FBORDER<20&($P(FBUCA,U,8)):"@",1:0)
|
|
I FBACT="REC" N FBEXPD27 S FBEXPD27=$S(+$P(FBUCA,U,26)>0:0,+$P(FBUCA,U,19)>0:+$P(FBUCA,U,19),1:0)
|
|
S:'FBLET FBEXP=$$EXPIRE^FBUCUTL8(FBDA,$S(FBORDER>$$ORDER^FBUCUTL(+$P(FBUCA,U,24)):$S('$P(FBUCA,U,25):DT,1:+$P(FBUCA,U,25)),FBACT="REC":$S($D(FBEXPD27):FBEXPD27,1:0),FBORDER=55:+$P(FBUCAA,U,2),1:DT),FBUCA,FBORDER)
|
|
;
|
|
DIE ;die update
|
|
I $S(FBSTATUS:1,FBVALID'=0:1,FBEXP'=0:1,FBLET:1,FBORIG'=0:1,FBDISPDT'=0:1,1:0) S DA=FBDA,DIE="^FB583(",DR="[FB UNAUTHORIZED UPDATE]" D
|
|
.D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE D L -^FB583(FBDA)
|
|
..I FBUCP'=FBUCA!(FBUCPA'=FBUCAA) S DR="27////^S X=DUZ;28///^S X=DT" D
|
|
...I $P(FBUCAA,U,2)&($P(FBUCA,U,11)=5) S DR=DR_";53///^S X=DT"
|
|
...D ^DIE
|
|
.K DIE,DA,DR,DQ,FBLOCK
|
|
.D:FBDISP DELDAP^FBUCUTL3(FBDA)
|
|
.I $G(FBUCDISR)=0!($P($G(FBUCDISR),U)=1) D DISAPR^FBUCUTL8
|
|
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ;stop monitor
|
|
;
|
|
LETTER ;letter denoting change of status or disposition
|
|
N FBLETDT I FBLET,"^1^4^"'[(U_$P(FBUCA,U,11)_U) D AUTO^FBUCLET(FBDA,FBORDER,FBUCA,FBUC) ;print letter/update fields if letter prints
|
|
END ;kill variables and quit
|
|
K FBAUTH,FBLOCK,FBUCAA,FBUCP,FBUCPA,XRT0,XRTN,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE Q
|