source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/PRCAFBD.m@ 738

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1PRCAFBD ;WASH-ISC@ALTOONA,PA/CLH-Build FMS Billing Document ;8/2/95 3:14 PM
2V ;;4.5;Accounts Receivable;**16,48,86,90,119,165,204,203,173,220,184**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4EN(BILL,ERR) ;Process NEW BILL to FMS
5 S ERR=-1
6 Q:$D(RCONVERT)
7 I '$D(^PRCA(430,BILL,11)) S ERR="1^ACCOUNTING INFORMATION MISSING. CANNOT PROCESS BILL" Q
8 ;
9 ; funds 5014 (old), 2431 (old), 528701,03,04,09 and 4032 should not create a BD
10 S %=$P($G(^PRCA(430,BILL,11)),"^",17)
11 I %=5014!(%=2431)!(%=4032) Q
12 I %[5287 Q:$$PTACCT^PRCAACC(%)
13 ;
14 I '$D(PRCA("SITE")) S PRCA("SITE")=$S($G(BILL):$P($P($G(^PRCA(430,BILL,0)),"^"),"-"),1:$$SITE^RCMSITE)
15 K ^TMP("PRCABD",$J)
16 I $G(BILL)="" S ERR="1^Missing Bill Number"
17 I $D(^PRCA(430,BILL,0)),$P(^(0),U,9)="" S ERR="1^No debtor for bill" Q
18 N GECSFMS,REC,REC11,VENCODE,BFY,EFY,LINEFUND,%,%I,%H,X,VEN,CAT,CP,ADDR,AC,RJ,FMSNUM,FMSNUM1,VENDORID,ADD,DA,Y
19 D NOW^%DTC
20 I '$G(PRCA("AUTO_AUDIT")) W !,"Building FMS Billing Document. Please hold...",!
21 S REC=$G(^PRCA(430,BILL,0)),REC11=$G(^PRCA(430,BILL,11)),FMSNUM=$P($P(REC,U),"-")_$P($P(REC,U),"-",2)
22 ;gather vendor information
23 S VENCODE=$$VENDORID^RCXFMSUV(BILL)
24 I VENCODE="UNKNOWN" S ERR="1^Need FMS Vendor ID for BD Document" Q
25 I VENCODE="LINK" S ERR="1^Debtor must be linked to vendor file" Q
26 S ADD=$$SADD^RCFN01(5)
27 I (VENCODE="PERSONOTH")!(VENCODE="XEMPL")!(VENCODE="CUREMPL")!($E(VENCODE,1,4)="CHMP")!($E(VENCODE,1,3)="TRI")!(VENCODE="INELIG") D
28 . N I F I=1:1:6 S ADDR(I)=$P(ADD,U,I)
29 . I ADDR(6)["-" S ADDR(7)=$P(ADDR(6),"-",2),ADDR(6)=$P(ADDR(6),"-")
30 . Q
31 N FMSDT S FMSDT=$$FMSDATE^RCBEUTRA(DT)
32 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)
33 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^~"
34 S ^TMP("PRCABD",$J,2)="LIN^~"
35 ;accouting information - stored on 11th node file 430
36 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)
37 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^^^^"
38 S ^TMP("PRCABD",$J,3)=^TMP("PRCABD",$J,3)_$P(REC11,U,10)_"^^^^^^^^"_$P(REC11,U,2)_U_$P(REC11,U,3)_"^~"
39 I $E($P(REC11,U,17),1,4)=5287 S $P(^TMP("PRCABD",$J,3),U,3)="05"
40 ;build control segment
41 D CONTROL^GECSUFMS("A",PRCA("SITE"),FMSNUM,"BD",10,"","","Billing Document")
42 S FMSNUM1=$P($G(GECSFMS("DOC")),U,3)_"-"_$P($G(GECSFMS("DOC")),U,4)
43 ;build and send document to FTH
44 S DA=0 F S DA=$O(^TMP("PRCABD",$J,DA)) Q:'DA D SETCS^GECSSTAA(GECSFMS("DA"),^(DA))
45 D OPEN^RCFMDRV1(FMSNUM1,6,"B"_BILL,.ENT,.ERR,BILL) I ERR]"" D
46 . S ERR=-1
47 . N Z S Z="Unable to create an entry in AR Document file."
48 . I '$G(PRCA("AUTO_AUDIT")) W !!,Z,! Q
49 . D SETERR^PRCAUDT("BILL: "_$$BILL^PRCAUDT(BILL)),SETERR^PRCAUDT(Z)
50 D SETCODE^GECSSDCT(GECSFMS("DA"),"D RETN^RCFMFN02")
51 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
52 D SSTAT^RCFMFN02(FMSNUM1,1)
53 I '$G(PRCA("AUTO_AUDIT")) D
54 . S Y=FMSDT D DD^%DT
55 . W !!,"FMS document, # ",GECSFMS("DA"),", built and queued for transmission on "_Y,!!
56 Q
57 ;
Note: See TracBrowser for help on using the repository browser.