source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPAID.m@ 1437

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1FBPAID ;WOIFO/SAB-SERVER ROUTINE TO UPDATE PAYMENTS ;9/9/2003
2 ;;3.5;FEE BASIS;**5,61**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;incoming record from AAC will contain the following data
5 ; - Fee Program - from Fee Basis Program (161.8)
6 ; - Activity Code (C - confirmed)
7 ; (B - backout)
8 ; (X - cancelled)
9 ; - Internal Control Number - IEN of payment record
10 ; - Check Number
11 ; - Check Date
12 ; - Interest Amount
13 ; - Cancellation Date
14 ; - Reason Code (File # 162.95)
15 ; - Cancellation Code (R - C - X)
16 ; - Disbursed Amount (this amount minus interest amount = amt pd)
17 ; variable 'FBPAID' is defined and passed to TRAP^FBMRASVR2
18 ;
19 N FBINV
20 S U="^",FBPAID=1,FBMCNT=0
21 S X="TRAP^FBMRASV2" S @^%ZOSF("TRAP")
22 ;K XMY S XMY("G.FEE")="" D ENT1^XMD
23 K ^TMP("FBPAID",$J),^TMP("FBERR",$J)
24 D STATION^FBAAUTL I $S($G(FB("ERROR")):1,'$G(FBAASN):1,1:0) Q
25 K FB
26 ;start to read in message from central fee
27 ;edits are:
28 ; 1. invalid station number
29 ; 2. invalid record length
30 ; 3. unable to locate payment record
31 ; 4. disbursed amount '= amt paid+interest
32 ; 5. cancellations
33 ; XMRG=record received in mail message from Austin
34 F I=1:1 X XMREC Q:XMER<0 I XMRG]"",$E(XMRG,1,3)=FBAASN D
35 .S ^TMP("FBREC",$J,I)=XMRG
36 .K FBERR
37 .I $L(XMRG)'=77 S FBERR=1,^TMP("FBERR",$J,2,I)=""
38 .D PARSE^FBPAID1 Q:$G(FBERR) S FBMCNT=FBMCNT+1 D @FBPROG
39 D ^FBPAID2:$D(^TMP("FBERR",$J))
40 D BUL^FBPAID1
41 ; if any EDI invoices then add to FPPS queue
42 I $D(FBINV) D PAIDLOG^FBFHLL(.FBINV)
43 G END
44 ;
453 ;update outpatient payment record
46 Q:'$D(^FBAAC(+FBIEN(3),1,+FBIEN(2),1,FBIEN(1),1,FBIEN,0)) S FBAMT=+$P(^(0),U,3) D
47 .I FBDAMT-FBINAMT'=FBAMT,$G(FBACT)="C" S ^TMP("FBERR",$J,4,I)=""_U_FBPROG_U_+FBIEN(3)_U_+FBIEN(2)_U_+FBIEN(1)_U_+FBIEN
48 N JJ F JJ=1:1:3 S DA(JJ)=+FBIEN(JJ)
49 S DA=+FBIEN
50 S DR=""
51 I FBACT="C" S DR="12////^S X=$G(FBCKDT);35///^S X=FBCKNUM;40///^S X=FBDAMT;41///^S X=FBINAMT;36///@;37///@"
52 I FBACT="B" S DR="12///@;35///@;36///@;37///@;40///@;41///@"
53 I FBACT="X" S DR="12///@;40///@;41///@;36////^S X=FBXDT;37////^S X=$G(FBRCOD);38///^S X=FBXCOD" D
54 .I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN(3)_U_+FBIEN(2)_U_+FBIEN(1)_U_+FBIEN
55 .I FBXCOD="R" S DR=DR_";35///@"
56 S DIE="^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
57 D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA)
58 ; if EDI then add invoice to list in FBINV(, patch *61
59 I FBACT'="B",$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,3)),U)]"" D
60 . N FBAAIN
61 . S FBAAIN=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0)),U,16)
62 . I FBAAIN]"" S FBINV(3,FBAAIN)=""
63 D KILL
64 Q
65 ;
665 ;update pharmacy payment record
67 Q:'$D(^FBAA(162.1,+FBIEN(1),"RX",+FBIEN,0)) S FBAMT=+$P(^(0),U,16) D
68 . I FBDAMT-FBINAMT'=FBAMT,$G(FBACT)="C" S ^TMP("FBERR",$J,4,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
69 S DA(1)=+FBIEN(1),DA=+FBIEN
70 S DR=""
71 I FBACT="C" S DR="28////^S X=FBCKDT;30///^S X=FBCKNUM;34///^S X=FBDAMT;35///^S X=FBINAMT;31///@;32///@"
72 I FBACT="B" S DR="28///@;30///@;31///@;32///@;34///@;35///@"
73 I FBACT="X" S DR="28///@;34///@;35///@;31////^S X=FBXDT;32////^S X=$G(FBRCOD);33///^S X=FBXCOD" D
74 .I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
75 .I FBXCOD="R" S DR=DR_";30///@"
76 S DIE="^FBAA(162.1,"_DA(1)_",""RX"","
77 D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAA(162.1,DA(1),"RX",DA)
78 ; if EDI then add invoice to list in FBINV(, patch *61
79 I FBACT'="B",$P($G(^FBAA(162.1,DA(1),0)),U,13)]"" D
80 . N FBAAIN
81 . S FBAAIN=$P($G(^FBAA(162.1,DA(1),0)),U)
82 . I FBAAIN]"" S FBINV(5,FBAAIN)=""
83 D KILL
84 Q
85 ;
869 ;update inpatient payment record
87 Q:'$D(^FBAAI(+FBIEN,0)) S FBAMT=+$P(^(0),U,9) D
88 .I FBDAMT-FBINAMT'=FBAMT,$G(FBACT)="C" S ^TMP("FBERR",$J,4,I)=""_U_FBPROG_U_+FBIEN
89 S DA=+FBIEN
90 S DR=""
91 I FBACT="C" S DR="45////^S X=FBCKDT;48///^S X=FBCKNUM;52///^S X=FBDAMT;53///^S X=FBINAMT;49///@;50///@"
92 I FBACT="B" S DR="45///@;48///@;49///@;50///@;52///@;53///@"
93 I FBACT="X" S DR="45///@;52///@;53///@;49////^S X=FBXDT;50////^S X=$G(FBRCOD);51///^S X=FBXCOD" D
94 .I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN
95 .I FBXCOD="R" S DR=DR_";48///@"
96 S DIE="^FBAAI("
97 D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAI(DA)
98 ; if EDI then add invoice to list in FBINV(, patch *61
99 I FBACT'="B",$P($G(^FBAAI(DA,3)),U)]"" D
100 . N FBAAIN
101 . S FBAAIN=$P($G(^FBAAI(DA,0)),U)
102 . I FBAAIN]"" S FBINV(9,FBAAIN)=""
103 D KILL
104 Q
105 ;
106T ;update travel payment record
107 Q:'$D(^FBAAC(+FBIEN(1),3,+FBIEN,0)) S FBAMT=+$P(^(0),U,3) D
108 . I FBDAMT-FBINAMT'=FBAMT,$G(FBACT)="C" S ^TMP("FBERR",$J,4,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
109 S DA(1)=+FBIEN(1),DA=+FBIEN
110 S DR=""
111 I FBACT="C" S DR="8////^S X=FBCKDT;9///^S X=FBCKNUM;13///^S X=FBDAMT;14///^S X=FBINAMT;10///@;11///@"
112 I FBACT="B" S DR="8///@;9///@;10///@;11///@;13///@;14///@"
113 I FBACT="X" S DR="8///@;13///@;14///@;10////^S X=FBXDT;11////^S X=$G(FBRCOD);12///^S X=FBXCOD" D
114 .I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
115 .I FBXCOD="R" S DR=DR_";9///@"
116 S DIE="^FBAAC("_+FBIEN(1)_",3,"
117 D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAC(DA(1),3,DA)
118 D KILL
119 Q
120 ;
121END ;clean and exit
122 S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
123 K FB,FBPAID,FBSITE,FBAASN,FBSN,FBMCNT,I,XMER,XMSER,XMREC,XMRG,XMY,^TMP("FBERR",$J),^TMP("FBPAID",$J),^TMP("FBREC",$J)
124KILL K FBLOCK,DIE,DA,DR,FBIEN,FBACT,FBCKNUM,FBRCOD,FBPROG,FBCKDT,FBXDT,FBXCOD,FBINAMT,FBDAMT,FBAMT,FBERR
125 Q
Note: See TracBrowser for help on using the repository browser.