source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCJIBFN2.m@ 862

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1RCJIBFN2 ;WASH-ISC@ALTOONA,PA/NYB-FUNC. CALLS FOR JOINT IB/AR ;10/12/95 8:34 AM ; 7/19/96 1:38 PM
2V ;;4.5;Accounts Receivable;**15,50,59,69,63**;Mar 20, 1995
3TRAN(RCTYNO) ;Pass IFN from 430.3 - returns the transaction type from file 430.3
4 N TRAN
5 I '$G(RCTYNO) S TRAN="" G TRANQ
6 S TRAN=$P($G(^PRCA(430.3,RCTYNO,0)),"^")
7TRANQ Q TRAN
8 ;
9STNO(RCTYNO) ;Pass IFN for 430.3 - returns pieces of the 0 node 430.3 where
10 ;$P1=Name,$P2=Abbreviation,$P3=Status Number
11 N SNDE,STNO,STRG
12 I '$G(RCTYNO) S STRG="" G STNOQ
13 S SNDE=$G(^PRCA(430.3,+RCTYNO,0)) I SNDE="" S STRG="" G STNOQ
14 S STRG=$P($G(SNDE),"^")_"^"_$P($G(SNDE),"^",2)_"^"_$P($G(SNDE),"^",3)
15STNOQ Q STRG
16 ;
17STAT(BN) ;Pass in IFN for 430 - returns the IFN for status file 430.3
18 N STAT
19 I '$G(BN) S STAT="" G STATQ
20 S STAT=+$P($G(^PRCA(430,BN,0)),"^",8)
21STATQ Q STAT
22 ;
23TRN(BN) ;Pass in IFN for 430 - returns ^TMP array with all transaction
24 ;for a bill where I is the transaction number in 433 and
25 ;$P1=Transaction Number,$P2=Transaction Date,$P3=Transaction Type
26 ;$P4=Transaction Amount,$P5=Amount Due after transaction applied
27 ;(Current Balance),$P6=Transaction Comment
28 ;Caller must kill ^TMP array
29 N BAL,CAT,I,N1,N8,TAMT,TTY
30 I '$G(BN) G TRNQ
31 K ^TMP("RCJIB",$J)
32 S CAT=$$CAT^PRCAFN(BN)
33 S BAL=+$P($$BILL(BN),"^")
34 S I=0 F S I=$O(^PRCA(433,"C",BN,I)) Q:'I D
35 .S N1=$G(^PRCA(433,I,1)),TTY=$P($G(N1),"^",2)
36 .S TAMT=$P($G(N1),"^",5)
37 .I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TTY_",") I TAMT'<0 S TAMT=-TAMT
38 .I ",2,8,9,10,11,14,19,47,34,35,29,"'[(","_TTY_",") I TAMT<0 S TAMT=-TAMT
39 .S N8=$G(^PRCA(433,I,8))
40 .I +CAT=33,TTY=1 I TAMT<0 S TAMT=-TAMT
41 .I +CAT=33,TTY=35 I TAMT>0 S TAMT=-TAMT
42 .I TTY>2,(TTY<7)!(TTY=25) S TAMT=0
43 .S BAL=BAL+TAMT
44 .S ^TMP("RCJIB",$J,I)=$P($G(^PRCA(433,I,0)),"^")_"^"_$P($G(N1),"^")_"^"_$P($G(N1),"^",2)_"^"_$P($G(N1),"^",5)_"^"_BAL_"^"_$P($G(N8),"^",6)
45 .Q
46TRNQ Q
47 ;
48BILL(BN) ;Pass in IFN for 430 - Returns pieces of the 0 node of 430
49 ;and pieces of calculated from file 433 where
50 ;$P1=Orginal Amount,$P2=Current Status,$P3=Current Balance
51 ;$P4=Total Collected,$P5=% Collected
52 N BAL,BN0,CST,I,PAY,PER,STRG,TP
53 I '$G(BN) S STRG="" G BILLQ
54 S BN0=$G(^PRCA(430,BN,0)) I '$G(BN0) S STRG="" G BILLQ
55 S CST=$P($G(BN0),"^",8)
56 S BAL=$G(^PRCA(430,BN,7)),BAL=$P(BAL,"^")+$P(BAL,"^",2)+$P(BAL,"^",3)+$P(BAL,"^",4)+$P(BAL,"^",5)
57 I CST=26 S BAL=0
58 I '$G(BN) S STRG="" G TRNQ
59 S (I,TP)=0 F S I=$O(^PRCA(433,"C",BN,I)) Q:'I D
60 .S PAY=$P($G(^PRCA(433,I,1)),"^",2)
61 .I $G(PAY)=2!($G(PAY)=34) S TP=TP+$P($G(^PRCA(433,I,1)),"^",5)
62 .Q
63 S PER="" I '$P($G(BN0),"^",3)=0 S PER=TP/($P($G(BN0),"^",3))*100
64 S STRG=$P($G(BN0),"^",3)_"^"_CST_"^"_BAL_"^"_TP_"^"_PER
65BILLQ Q STRG
66 ;
67BCOM(BN) ;Pass in IFN for 430 - Returns COM where $P1=Person who audited and
68 ;$P2=Date audited and COM array where COM(I) is the audit comments
69 ;Caller must kill COM ARRAY
70 N FL,I
71 I '$G(BN) S COM="" G BCOMQ
72 S COM="",(FL,I)=0 F S I=$O(^PRCA(430,BN,10,I)) Q:I="" D
73 .S FL=1,COM(I)=$P($G(^PRCA(430,BN,10,I,0)),"^")
74 .Q
75 I FL S COM=$P($G(^PRCA(430,BN,9)),"^")_"^"_$P($G(^PRCA(430,BN,9)),"^",3)
76BCOMQ Q
77 ;
78DIQ(DA,DR,RCDIQ) ;Return File 430 data from Fileman
79 ;DA - IEN, DR - File 430 fields, RCDIQ - Array name
80 N D0,DIC,DIQ,DIQ2
81 I ($G(^PRCA(430,DA,0))="")!(DR="")!(RCDIQ="") G DIQQ
82 S DIQ(0)="IE",DIC="^PRCA(430,",DIQ=RCDIQ
83 D EN^DIQ1
84DIQQ Q
85 ;
86 ;RCJIBFN2
Note: See TracBrowser for help on using the repository browser.