97 lines
5.8 KiB
Mathematica
97 lines
5.8 KiB
Mathematica
PRCARFD1 ;WASH-ISC@ALTOONA,PA/LDB-APPROVE REFUND AND GENERATE FMS DOC ;2/14/96 9:13 AM
|
|
;;4.5;Accounts Receivable;**21,36,90,104,141,190,204,203,207,220,238**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
APPRV ;Enter Elec sig for CFO
|
|
N ADD,DA,ENT,ERROR,PRCABN0,PRCANM,RA,TIME,X,Y
|
|
F X=1:1:5 S RA=+$G(RA)+$P($G(^PRCA(430,PRCABN,7)),U,X)
|
|
I +$G(RA)'=$P($G(^PRCA(430,PRCABN,7)),U,18) W !!,"REFUND AMOUNT OUT-OF-BALANCE!" Q
|
|
S DA=+PRCABN D SIG^PRCASIG I $G(PRCANM)']"" W !!,"DID NOT APPROVE REFUND" Q
|
|
L +^PRCA(430,PRCABN):1 Q:'$T S $P(^PRCA(430,PRCABN,9),U,2)=PRCANM,$P(^(9),U,1)=DUZ,$P(^(9),U,3)=$G(DT) L -^PRCA(430,PRCABN) W !," <APPROVED BY CERTIFYING OFFICER>"
|
|
I $G(^PRCA(430,PRCABN,7))'>0 W !!,*7,"This Accounts Receivable doesn't have an excess payment !" D CANC^PRCARFD(PRCABN) W !!,"Status Changed to 'CANCELLATION'",! Q
|
|
W *7,!!,"No other transactions may be made to the bill now."
|
|
;
|
|
FMSDOC ;Create FMS overcollection payment voucher document
|
|
;
|
|
N %,ADD,GECSFMS,DATE,DEBT,DY,MO,PRCA,PRCANM,STAT,YR,DOC
|
|
I '$D(^PRCA(430,+$G(PRCABN),0)) W !,"THIS BILL NUMBER ENTRY IN FILE 430 IS CORRUPTED",!,"NO PROCESSING CAN CONTINUE - SEE IRM" Q
|
|
S PRCABN0=$G(^PRCA(430,+PRCABN,0)),PRCANM=$P(PRCABN0,"^")
|
|
S STAT=$$GSTAT^RCFMFN02(PRCANM)
|
|
I STAT>0&(STAT<3) W !!,*7,"THIS DOCUMENT SEEMS TO HAVE ALREADY BEEN SENT TO FMS-",!,"IT CANNOT BE RESENT UNLESS FMS REJECTS IT." Q
|
|
FMS W !!,"Creating an FMS Overcollection Payment Voucher . . .",!
|
|
S PRCA("STN")=$P($P(PRCABN0,U),"-")
|
|
S DEBT=+$P(PRCABN0,U,9),DEBT=$P($G(^RCD(340,DEBT,0)),U)
|
|
S PRCA("VNAME")=$$NAM^RCFN01(DEBT) I PRCA("VNAME")="" S ADD=0
|
|
S PRCA("VNAME")=$P(PRCA("VNAME"),",",2)_" "_$P(PRCA("VNAME"),",")
|
|
S PRCA("VCODE")=$$SSN^RCFN01(DEBT)
|
|
S ADD=1
|
|
S PRCA("ADD")=$$DADD^RCAMADD(DEBT,1)
|
|
S PRCA("VADD1")=$P(PRCA("ADD"),U) I PRCA("VADD1")="" S ADD=0
|
|
S PRCA("VADD2")=$P(PRCA("ADD"),U,2)
|
|
S PRCA("VCITY")=$P(PRCA("ADD"),U,4) I PRCA("VCITY")="" S ADD=0
|
|
S PRCA("VSTATE")=$P(PRCA("ADD"),U,5) I PRCA("VSTATE")="" S ADD=0
|
|
S PRCA("VZIP")=$P(PRCA("ADD"),U,6) I PRCA("VZIP")="" S ADD=0
|
|
S PRCA("LAMT")=$P($G(^PRCA(430,+PRCABN,7)),U,18)
|
|
S PRCANM=$P($G(^PRCA(430,+PRCABN,0)),U)
|
|
I 'ADD D Q
|
|
.W *7,!,"THIS PATIENT DOES NOT HAVE A VALID ADDRESS."
|
|
.W !,"AN FMS DOCUMENT CANNOT BE CREATED WITHOUT A VALID ADDRESS."
|
|
.Q
|
|
I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *",!
|
|
D NOW^%DTC S YR=$E(%,2,3),MO=$E(%,4,5),DY=$E(%,6,7)
|
|
S Y=$P(%,".") X ^DD("DD") S DATE=$P(Y,",",2)_MO_DY
|
|
S TIME=$P(%,".",2)
|
|
S PRCA("FY")=$$FY^RCFN01($P(%,"."))
|
|
S PRCA("LAMT")=$J(PRCA("LAMT"),0,2)
|
|
D CONTROL^GECSUFMS("A",PRCA("STN"),PRCANM,"OP",10,0,"","")
|
|
;S FMSTRING("CTL")="CTL^FMS^"_PRCA("STN")^DOC^OP^10^^"_PRCA("STN")_PRCA("FY")_SEQ_U_YYYYMMDD_U_TIME_U_SEQ_U_PRCANM_"^ARS"_PRCA("STN")_U_VER
|
|
I '$D(GECSFMS("DA")) W !,"AN ENTRY WAS NOT MADE IN THE STACKER FILE.",!,"PLEASE RE-SELECT THE BILL IN THE APPROVE OPTION." Q
|
|
S DOC=$S($G(GECSFMS("DOC"))]"":$P(GECSFMS("DOC"),"^",3)_"-"_$P(GECSFMS("DOC"),"^",4),1:PRCANM)
|
|
D OPEN^RCFMDRV1(DOC,5,"B"_PRCABN,.ENT,.ERROR,PRCABN)
|
|
I ERROR]"" W !!,*7,"AN AR DOC REF CANNOT BE CREATED BECAUSE THE FOLLOWING ERROR HAS OCCURRED -",!?10,ERROR,!
|
|
N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
|
|
S ^TMP($J,"PRCA",1)="PV2^"_$E(FMSDT,4,5)_U_$E(FMSDT,6,7)_U_$E(FMSDT,2,3)_"^^^^^E^01^^^^^^^^^^MISCVET^^"_PRCA("LAMT")_"^"
|
|
S ^TMP($J,"PRCA",2)=PRCA("VNAME")_U_$E(PRCA("VADD1"),1,30)_U_$E(PRCA("VADD2"),1,30)_U_PRCA("VCITY")_U_PRCA("VSTATE")_U_PRCA("VZIP")_"^~"
|
|
D
|
|
. N PRCAPT
|
|
. S PRCAPT=$S(DT<3030926:5287,$G(REFMS)&(DT<3031001):5287,DT'<3030926&(DT<$$ADDPTEDT^PRCAACC()):5287.3,1:528703)
|
|
.S:$E(PRCAPT,1,4)=5287 PRCA("FY")="05" ; FY
|
|
.S ^TMP($J,"PRCA",3)="LIN^~PVA^001^^^^^^^^^^^"_PRCA("FY")_"^^"_PRCAPT_"^"_PRCA("STN")_"^^^^^^^^^^^"_$$CALCRSC^RCXFMSUR(+PRCABN)_"^^^^^^"_PRCA("LAMT")_"^I^~"
|
|
.;S ^TMP($J,"PRCA",3)="LIN^~PVA^001^^^^^^^^^^^"_PRCA("FY")_"^^"_$S(DT<3030926:5287,$G(REFMS)&(DT<3031001):5287,1:528703)_"^"_PRCA("STN")_"^^^^^^^^^^^"_$$CALCRSC^RCXFMSUR(+PRCABN)_"^^^^^^"_PRCA("LAMT")_"^I^~"
|
|
S DA=0 F S DA=$O(^TMP($J,"PRCA",DA)) Q:'DA D
|
|
.D SETCS^GECSSTAA(GECSFMS("DA"),^TMP($J,"PRCA",DA))
|
|
D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
|
|
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
|
|
D SSTAT^RCFMFN02("B"_+$G(PRCABN),1)
|
|
Q:$P($G(^PRCA(430,+$G(PRCABN),0)),U,8)=$O(^PRCA(430.3,"AC",41,0))
|
|
K ^TMP($J)
|
|
;Pass to FMS
|
|
;Call generic interface to setup document if completed flag proceed
|
|
;change date if resent to FMS
|
|
;
|
|
TREF ;Create REFUNDED transaction and set to REFUNDED status
|
|
N DIE,DR,DA,PRCASVC,PRCAA2,PRCAEN,PRCAMT,X,Y,DIR,DEBTOR,CLYRRF
|
|
S U="^"
|
|
I $P($G(^PRCA(430,+PRCABN,0)),U,8)=$O(^PRCA(430.3,"AC",120,0)) Q
|
|
D SETTR^PRCAUTL I '$G(PRCAEN) W !!,"COULD NOT SET UP A REFUND TRANSACTION!" Q
|
|
W !!,"Creating a REFUNDED transaction for bill number: ",$P(^PRCA(430,PRCABN,0),"^")," . . .",!
|
|
D PATTR^PRCAUTL S PRCA("ADJ")=$O(^PRCA(430.3,"AC",120,0)),PRCASV("BDT")=$G(DT),PRCASV("APR")=DUZ,PRCASV("FY")="^"_+$P($G(^PRCA(430,PRCABN,7)),U,18)
|
|
S DIE="^PRCA(433,",DR="[PRCA FY ADJ2 BATCH]",DA=PRCAEN D ^DIE
|
|
S PRCAMT=-$G(PRCAMT),PRCAA2=$P(^PRCA(433,PRCAEN,4,0),U,3)
|
|
D UPFY^PRCADJ,TRANUP^PRCAUTL
|
|
S $P(^PRCA(430,PRCABN,7),U,1)=$G(^PRCA(430,PRCABN,7))+PRCAMT,PRCA("STATUS")=$O(^PRCA(430.3,"AC",120,0)) D UPSTATS^PRCAUT2
|
|
W !,"Bill is now in REFUNDED status.",!
|
|
;CHECK TO SEE IF TOP REFUND AND SET UP FIELDS TO SEND WITH NEXT
|
|
;TOP TRANSMISSION
|
|
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Is this a TOP Refund",DIR("??")="Enter 'YES' only if this is a refund of a payment from TOP"
|
|
D ^DIR Q:'Y
|
|
S DEBTOR=$P(^PRCA(430,PRCABN,0),U,9) Q:'DEBTOR
|
|
S TRACE=$P($G(^RCD(340,DEBTOR,6)),U,7)
|
|
I $L(TRACE)'=10 W !,*7,"There is no valid trace number entered for this debtor",!,"Cannot process as TOP refund." Q
|
|
S CLYRRF=$E(DT,1,3)+1700,DA=PRCABN
|
|
S DIE="^PRCA(430,",DR="144//^S X=CLYRRF;142////1;143///^S X=TRACE"
|
|
S DA=PRCABN,DIE("NO^")=1 D ^DIE
|
|
W !,"TOP REFUND DOCUMENT WILL BE SENT WITH NEXT TOP TRANSMISSION"
|
|
Q
|
|
;
|