source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBUCUPD.m@ 1361

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1FBUCUPD(FBUCP,FBUCPA,FBUCA,FBUCAA,FBDA,FBACT,FBUCDISR) ;ALBISC/TET - UPDATE AFTER EVENT ;11/15/01
2 ;;3.5;FEE BASIS;**8,27,38**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4UPDATE ;update if before and after values differ
5 ;INPUT: FBUCP - zero node of 162.7, prior
6 ; FBUCPA- 'A' (appeal) node of 162.7, prior
7 ; FBUCA - zero node of 162.7, after
8 ; FBUCAA- 'A' (appeal) node of 162.7, after
9 ; FBDA - IEN of 162.7
10 ; FBACT - action type
11 ; FBUCDISR - (option) exists if disapp.
12 ; 1 = denial reasons for gr to be same as prim
13 ; 0 = ask denial reason for each claim in gr
14 ;VARIABLES:
15 ; FBSTATUS - 0 if no change, or status ien to 162.92
16 ; FBORDER - order number of status in 162.92
17 ; FBLET - = 1 if status or disp. changed (letter should be printed)
18 ; FBDISP - flag if disp. changed to approved from other
19 ; than approved. 1 to delete disap. reasons
20 ; 0 no action
21 ; FBDISPDT - date disp. changed, 0 if no change, "@" to delete
22 ; FBEXP - exp. date, 0 if no change, "@" to delete
23 ; or new date in internal format
24 ; FBVALID - valid date claim rec., 0 if no change, "@" to delete
25 ; or today's date in internal format
26 ; FBORIG - date of original disp. or "@" to delete
27 ; to approve. 1 is to set in file 161, 0 is to delete.
28 I $S('+$G(FBDA):1,$G(FBACT)']"":1,$G(FBUCA)']"":1,1:0) G END
29AUTH ;determine if auth. needs to be updated, based upon disp.
30 ;returns variable FBAUTH, may returne FBOUT
31 D AUTH^FBUCUPD1(FBUCP,FBUCA,FBDA,FBACT)
32 ;
33Q ;enter code to task remainder of update here
34 ;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")=""
35 ;D ^%ZTLOAD G END
36 ;
37DQ ;de-queue tasked job here
38 D:$D(XRTL) T0^%ZOSV ;start monitor
39 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)
40 ;
41STATUS ;determine status of claim
42 ;FBST=status of claim prior to update;updated to most current
43 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)
44 ;
45DISP ;dispostion change
46 I $P(FBUCP,U,11)'=$P(FBUCA,U,11),$P(FBUCA,U,11) D
47 .S FBST=$S($P(FBUCAA,U,6):90,$P(FBUCAA,U,4):70,1:40)
48 .S FBDISPDT=DT,FBORIG=$S('$P(FBUCP,U,11)&(FBST=40):DT,1:0)
49 I $P(FBUCP,U,11)'=$P(FBUCA,U,11),'$P(FBUCA,U,11) D
50 .N FBO S FBO=$$ORDER^FBUCUTL(+$P(FBUCP,U,24))
51 .I FBO=90 S FBST=$S($P(FBUCAA,U,5):80,1:70)
52 .I FBO=70 S FBST=$S($P(FBUCAA,U,3):60,$P(FBUCAA,U,2):55,$P(FBUCAA,U):50,1:40)
53 .I FBO=40 S FBST=$S($$PEND^FBUCUTL(FBDA):10,1:30)
54 .S FBDISPDT="@",FBORIG=$S($$ORDER^FBUCUTL($P(FBUCP,U,24))=40:"@",1:0)
55 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
56 I $P(FBUCP,U,11)=$P(FBUCA,U,11),FBUCPA=FBUCAA S FBST=$S($P(FBUCA,U,11):40,1:FBST)
57 ;
58APPEAL ;appeal change - check if disposition remains unchanged
59 I FBUCAA]""!(FBUCPA'=FBUCAA) D
60 .I $P(FBUCAA,U,2)&($P(FBUCA,U,11)=5) S FBST=70 Q
61 .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)
62 ;
63 S FBORDER=FBST,FBSTATUS=$$STATUS^FBUCUTL(FBORDER) S:FBORIG]"" $P(FBUCA,U,22)=$S(FBORIG="@":"",FBORIG=0:"",1:FBORIG)
64 I FBSTATUS,FBSTATUS'=$P(FBUCA,U,24)!(FBUCP']"")!((FBORDER=10)&("^ENT^REQ^"[FBACT)) D
65 .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)
66 .S FBVALID=$S(FBORDER>20&('$P(FBUCA,U,8))&('$$PEND^FBUCUTL(FBDA)):DT,FBORDER<20&($P(FBUCA,U,8)):"@",1:0)
67 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)
68 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)
69 ;
70DIE ;die update
71 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
72 .D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE D L -^FB583(FBDA)
73 ..I FBUCP'=FBUCA!(FBUCPA'=FBUCAA) S DR="27////^S X=DUZ;28///^S X=DT" D
74 ...I $P(FBUCAA,U,2)&($P(FBUCA,U,11)=5) S DR=DR_";53///^S X=DT"
75 ...D ^DIE
76 .K DIE,DA,DR,DQ,FBLOCK
77 .D:FBDISP DELDAP^FBUCUTL3(FBDA)
78 .I $G(FBUCDISR)=0!($P($G(FBUCDISR),U)=1) D DISAPR^FBUCUTL8
79 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ;stop monitor
80 ;
81LETTER ;letter denoting change of status or disposition
82 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
83END ;kill variables and quit
84 K FBAUTH,FBLOCK,FBUCAA,FBUCP,FBUCPA,XRT0,XRTN,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE Q
Note: See TracBrowser for help on using the repository browser.