126 lines
5.3 KiB
Mathematica
126 lines
5.3 KiB
Mathematica
FBPAID ;WOIFO/SAB-SERVER ROUTINE TO UPDATE PAYMENTS ;9/9/2003
|
|
;;3.5;FEE BASIS;**5,61**;JAN 30, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;incoming record from AAC will contain the following data
|
|
; - Fee Program - from Fee Basis Program (161.8)
|
|
; - Activity Code (C - confirmed)
|
|
; (B - backout)
|
|
; (X - cancelled)
|
|
; - Internal Control Number - IEN of payment record
|
|
; - Check Number
|
|
; - Check Date
|
|
; - Interest Amount
|
|
; - Cancellation Date
|
|
; - Reason Code (File # 162.95)
|
|
; - Cancellation Code (R - C - X)
|
|
; - Disbursed Amount (this amount minus interest amount = amt pd)
|
|
; variable 'FBPAID' is defined and passed to TRAP^FBMRASVR2
|
|
;
|
|
N FBINV
|
|
S U="^",FBPAID=1,FBMCNT=0
|
|
S X="TRAP^FBMRASV2" S @^%ZOSF("TRAP")
|
|
;K XMY S XMY("G.FEE")="" D ENT1^XMD
|
|
K ^TMP("FBPAID",$J),^TMP("FBERR",$J)
|
|
D STATION^FBAAUTL I $S($G(FB("ERROR")):1,'$G(FBAASN):1,1:0) Q
|
|
K FB
|
|
;start to read in message from central fee
|
|
;edits are:
|
|
; 1. invalid station number
|
|
; 2. invalid record length
|
|
; 3. unable to locate payment record
|
|
; 4. disbursed amount '= amt paid+interest
|
|
; 5. cancellations
|
|
; XMRG=record received in mail message from Austin
|
|
F I=1:1 X XMREC Q:XMER<0 I XMRG]"",$E(XMRG,1,3)=FBAASN D
|
|
.S ^TMP("FBREC",$J,I)=XMRG
|
|
.K FBERR
|
|
.I $L(XMRG)'=77 S FBERR=1,^TMP("FBERR",$J,2,I)=""
|
|
.D PARSE^FBPAID1 Q:$G(FBERR) S FBMCNT=FBMCNT+1 D @FBPROG
|
|
D ^FBPAID2:$D(^TMP("FBERR",$J))
|
|
D BUL^FBPAID1
|
|
; if any EDI invoices then add to FPPS queue
|
|
I $D(FBINV) D PAIDLOG^FBFHLL(.FBINV)
|
|
G END
|
|
;
|
|
3 ;update outpatient payment record
|
|
Q:'$D(^FBAAC(+FBIEN(3),1,+FBIEN(2),1,FBIEN(1),1,FBIEN,0)) S FBAMT=+$P(^(0),U,3) D
|
|
.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
|
|
N JJ F JJ=1:1:3 S DA(JJ)=+FBIEN(JJ)
|
|
S DA=+FBIEN
|
|
S DR=""
|
|
I FBACT="C" S DR="12////^S X=$G(FBCKDT);35///^S X=FBCKNUM;40///^S X=FBDAMT;41///^S X=FBINAMT;36///@;37///@"
|
|
I FBACT="B" S DR="12///@;35///@;36///@;37///@;40///@;41///@"
|
|
I FBACT="X" S DR="12///@;40///@;41///@;36////^S X=FBXDT;37////^S X=$G(FBRCOD);38///^S X=FBXCOD" D
|
|
.I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN(3)_U_+FBIEN(2)_U_+FBIEN(1)_U_+FBIEN
|
|
.I FBXCOD="R" S DR=DR_";35///@"
|
|
S DIE="^FBAAC("_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
|
|
D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA)
|
|
; if EDI then add invoice to list in FBINV(, patch *61
|
|
I FBACT'="B",$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,3)),U)]"" D
|
|
. N FBAAIN
|
|
. S FBAAIN=$P($G(^FBAAC(DA(3),1,DA(2),1,DA(1),1,DA,0)),U,16)
|
|
. I FBAAIN]"" S FBINV(3,FBAAIN)=""
|
|
D KILL
|
|
Q
|
|
;
|
|
5 ;update pharmacy payment record
|
|
Q:'$D(^FBAA(162.1,+FBIEN(1),"RX",+FBIEN,0)) S FBAMT=+$P(^(0),U,16) D
|
|
. I FBDAMT-FBINAMT'=FBAMT,$G(FBACT)="C" S ^TMP("FBERR",$J,4,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
|
|
S DA(1)=+FBIEN(1),DA=+FBIEN
|
|
S DR=""
|
|
I FBACT="C" S DR="28////^S X=FBCKDT;30///^S X=FBCKNUM;34///^S X=FBDAMT;35///^S X=FBINAMT;31///@;32///@"
|
|
I FBACT="B" S DR="28///@;30///@;31///@;32///@;34///@;35///@"
|
|
I FBACT="X" S DR="28///@;34///@;35///@;31////^S X=FBXDT;32////^S X=$G(FBRCOD);33///^S X=FBXCOD" D
|
|
.I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
|
|
.I FBXCOD="R" S DR=DR_";30///@"
|
|
S DIE="^FBAA(162.1,"_DA(1)_",""RX"","
|
|
D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAA(162.1,DA(1),"RX",DA)
|
|
; if EDI then add invoice to list in FBINV(, patch *61
|
|
I FBACT'="B",$P($G(^FBAA(162.1,DA(1),0)),U,13)]"" D
|
|
. N FBAAIN
|
|
. S FBAAIN=$P($G(^FBAA(162.1,DA(1),0)),U)
|
|
. I FBAAIN]"" S FBINV(5,FBAAIN)=""
|
|
D KILL
|
|
Q
|
|
;
|
|
9 ;update inpatient payment record
|
|
Q:'$D(^FBAAI(+FBIEN,0)) S FBAMT=+$P(^(0),U,9) D
|
|
.I FBDAMT-FBINAMT'=FBAMT,$G(FBACT)="C" S ^TMP("FBERR",$J,4,I)=""_U_FBPROG_U_+FBIEN
|
|
S DA=+FBIEN
|
|
S DR=""
|
|
I FBACT="C" S DR="45////^S X=FBCKDT;48///^S X=FBCKNUM;52///^S X=FBDAMT;53///^S X=FBINAMT;49///@;50///@"
|
|
I FBACT="B" S DR="45///@;48///@;49///@;50///@;52///@;53///@"
|
|
I FBACT="X" S DR="45///@;52///@;53///@;49////^S X=FBXDT;50////^S X=$G(FBRCOD);51///^S X=FBXCOD" D
|
|
.I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN
|
|
.I FBXCOD="R" S DR=DR_";48///@"
|
|
S DIE="^FBAAI("
|
|
D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAI(DA)
|
|
; if EDI then add invoice to list in FBINV(, patch *61
|
|
I FBACT'="B",$P($G(^FBAAI(DA,3)),U)]"" D
|
|
. N FBAAIN
|
|
. S FBAAIN=$P($G(^FBAAI(DA,0)),U)
|
|
. I FBAAIN]"" S FBINV(9,FBAAIN)=""
|
|
D KILL
|
|
Q
|
|
;
|
|
T ;update travel payment record
|
|
Q:'$D(^FBAAC(+FBIEN(1),3,+FBIEN,0)) S FBAMT=+$P(^(0),U,3) D
|
|
. I FBDAMT-FBINAMT'=FBAMT,$G(FBACT)="C" S ^TMP("FBERR",$J,4,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
|
|
S DA(1)=+FBIEN(1),DA=+FBIEN
|
|
S DR=""
|
|
I FBACT="C" S DR="8////^S X=FBCKDT;9///^S X=FBCKNUM;13///^S X=FBDAMT;14///^S X=FBINAMT;10///@;11///@"
|
|
I FBACT="B" S DR="8///@;9///@;10///@;11///@;13///@;14///@"
|
|
I FBACT="X" S DR="8///@;13///@;14///@;10////^S X=FBXDT;11////^S X=$G(FBRCOD);12///^S X=FBXCOD" D
|
|
.I FBXCOD'="R" S ^TMP("FBERR",$J,5,I)=""_U_FBPROG_U_+FBIEN(1)_U_+FBIEN
|
|
.I FBXCOD="R" S DR=DR_";9///@"
|
|
S DIE="^FBAAC("_+FBIEN(1)_",3,"
|
|
D LOCK^FBUCUTL(DIE,DA,1) I FBLOCK D ^DIE L -^FBAAC(DA(1),3,DA)
|
|
D KILL
|
|
Q
|
|
;
|
|
END ;clean and exit
|
|
S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
|
|
K FB,FBPAID,FBSITE,FBAASN,FBSN,FBMCNT,I,XMER,XMSER,XMREC,XMRG,XMY,^TMP("FBERR",$J),^TMP("FBPAID",$J),^TMP("FBREC",$J)
|
|
KILL K FBLOCK,DIE,DA,DR,FBIEN,FBACT,FBCKNUM,FBRCOD,FBPROG,FBCKDT,FBXDT,FBXCOD,FBINAMT,FBDAMT,FBAMT,FBERR
|
|
Q
|