| 1 | RCJIBFN2 ;WASH-ISC@ALTOONA,PA/NYB-FUNC. CALLS FOR JOINT IB/AR ;10/12/95  8:34 AM ; 7/19/96  1:38 PM
 | 
|---|
| 2 | V ;;4.5;Accounts Receivable;**15,50,59,69,63**;Mar 20, 1995
 | 
|---|
| 3 | TRAN(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)),"^")
 | 
|---|
| 7 | TRANQ Q TRAN
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 | STNO(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)
 | 
|---|
| 15 | STNOQ Q STRG
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 | STAT(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)
 | 
|---|
| 21 | STATQ Q STAT
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 | TRN(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
 | 
|---|
| 46 | TRNQ Q
 | 
|---|
| 47 |  ;
 | 
|---|
| 48 | BILL(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
 | 
|---|
| 65 | BILLQ Q STRG
 | 
|---|
| 66 |  ;
 | 
|---|
| 67 | BCOM(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)
 | 
|---|
| 76 | BCOMQ Q
 | 
|---|
| 77 |  ;
 | 
|---|
| 78 | DIQ(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
 | 
|---|
| 84 | DIQQ Q
 | 
|---|
| 85 |  ;
 | 
|---|
| 86 |  ;RCJIBFN2
 | 
|---|