58 lines
3.3 KiB
Mathematica
58 lines
3.3 KiB
Mathematica
PRCAFBD ;WASH-ISC@ALTOONA,PA/CLH-Build FMS Billing Document ;8/2/95 3:14 PM
|
|
V ;;4.5;Accounts Receivable;**16,48,86,90,119,165,204,203,173,220,184**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
EN(BILL,ERR) ;Process NEW BILL to FMS
|
|
S ERR=-1
|
|
Q:$D(RCONVERT)
|
|
I '$D(^PRCA(430,BILL,11)) S ERR="1^ACCOUNTING INFORMATION MISSING. CANNOT PROCESS BILL" Q
|
|
;
|
|
; funds 5014 (old), 2431 (old), 528701,03,04,09 and 4032 should not create a BD
|
|
S %=$P($G(^PRCA(430,BILL,11)),"^",17)
|
|
I %=5014!(%=2431)!(%=4032) Q
|
|
I %[5287 Q:$$PTACCT^PRCAACC(%)
|
|
;
|
|
I '$D(PRCA("SITE")) S PRCA("SITE")=$S($G(BILL):$P($P($G(^PRCA(430,BILL,0)),"^"),"-"),1:$$SITE^RCMSITE)
|
|
K ^TMP("PRCABD",$J)
|
|
I $G(BILL)="" S ERR="1^Missing Bill Number"
|
|
I $D(^PRCA(430,BILL,0)),$P(^(0),U,9)="" S ERR="1^No debtor for bill" Q
|
|
N GECSFMS,REC,REC11,VENCODE,BFY,EFY,LINEFUND,%,%I,%H,X,VEN,CAT,CP,ADDR,AC,RJ,FMSNUM,FMSNUM1,VENDORID,ADD,DA,Y
|
|
D NOW^%DTC
|
|
I '$G(PRCA("AUTO_AUDIT")) W !,"Building FMS Billing Document. Please hold...",!
|
|
S REC=$G(^PRCA(430,BILL,0)),REC11=$G(^PRCA(430,BILL,11)),FMSNUM=$P($P(REC,U),"-")_$P($P(REC,U),"-",2)
|
|
;gather vendor information
|
|
S VENCODE=$$VENDORID^RCXFMSUV(BILL)
|
|
I VENCODE="UNKNOWN" S ERR="1^Need FMS Vendor ID for BD Document" Q
|
|
I VENCODE="LINK" S ERR="1^Debtor must be linked to vendor file" Q
|
|
S ADD=$$SADD^RCFN01(5)
|
|
I (VENCODE="PERSONOTH")!(VENCODE="XEMPL")!(VENCODE="CUREMPL")!($E(VENCODE,1,4)="CHMP")!($E(VENCODE,1,3)="TRI")!(VENCODE="INELIG") D
|
|
. N I F I=1:1:6 S ADDR(I)=$P(ADD,U,I)
|
|
. I ADDR(6)["-" S ADDR(7)=$P(ADDR(6),"-",2),ADDR(6)=$P(ADDR(6),"-")
|
|
. Q
|
|
N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
|
|
S ^TMP("PRCABD",$J,1)="BD2^"_$E(FMSDT,4,5)_U_$E(FMSDT,6,7)_U_$E(FMSDT,2,3)_"^^^^^^E^"_$E(VENCODE,1,9)_U_$E(VENCODE,10,11)_U_$J($P(REC,U,3),0,2)_"^^^^"_$E($G(ADDR(1)),1,30)_U_$E($G(ADDR(2)),1,30)_U_$E($G(ADDR(3)),1,30)
|
|
S ^TMP("PRCABD",$J,1)=^TMP("PRCABD",$J,1)_U_$E($G(ADDR(4)),1,19)_U_$G(ADDR(5))_U_$G(ADDR(6))_U_$G(ADDR(7))_"^N^^^^^^W^~"
|
|
S ^TMP("PRCABD",$J,2)="LIN^~"
|
|
;accouting information - stored on 11th node file 430
|
|
S ^TMP("PRCABD",$J,3)="BDA^"_$$LINE^RCXFMSC1(BILL)_"^"_$P(REC11,U,15)_U_$P(REC11,U,16)_U_$P(REC11,U,17)_U_$P(REC11,U,8)_U_$P(REC11,U,11)_U_$P(REC11,U,20)_U_$P(REC11,U,6)_U_$P(REC11,U,7)_U_$P(REC11,U,21)_U_$P(REC11,U,5)
|
|
S ^TMP("PRCABD",$J,3)=^TMP("PRCABD",$J,3)_U_$P(REC11,U,12)_U_$P(REC11,U,14)_"^^"_$J($P(REC,U,3),0,2)_"^I^AR_INTERFACE^^^^"
|
|
S ^TMP("PRCABD",$J,3)=^TMP("PRCABD",$J,3)_$P(REC11,U,10)_"^^^^^^^^"_$P(REC11,U,2)_U_$P(REC11,U,3)_"^~"
|
|
I $E($P(REC11,U,17),1,4)=5287 S $P(^TMP("PRCABD",$J,3),U,3)="05"
|
|
;build control segment
|
|
D CONTROL^GECSUFMS("A",PRCA("SITE"),FMSNUM,"BD",10,"","","Billing Document")
|
|
S FMSNUM1=$P($G(GECSFMS("DOC")),U,3)_"-"_$P($G(GECSFMS("DOC")),U,4)
|
|
;build and send document to FTH
|
|
S DA=0 F S DA=$O(^TMP("PRCABD",$J,DA)) Q:'DA D SETCS^GECSSTAA(GECSFMS("DA"),^(DA))
|
|
D OPEN^RCFMDRV1(FMSNUM1,6,"B"_BILL,.ENT,.ERR,BILL) I ERR]"" D
|
|
. S ERR=-1
|
|
. N Z S Z="Unable to create an entry in AR Document file."
|
|
. I '$G(PRCA("AUTO_AUDIT")) W !!,Z,! Q
|
|
. D SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(BILL)),SETERR^PRCAUDT(Z)
|
|
D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
|
|
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
|
|
D SSTAT^RCFMFN02(FMSNUM1,1)
|
|
I '$G(PRCA("AUTO_AUDIT")) D
|
|
. S Y=FMSDT D DD^%DT
|
|
. W !!,"FMS document, # ",GECSFMS("DA"),", built and queued for transmission on "_Y,!!
|
|
Q
|
|
;
|