- RCJIBFN2 ;WASH-ISC@ALTOONA,PA/NYB-FUNC. CALLS FOR JOINT IB/AR ;10/12/95 8:34 AM ; 7/19/96 1:38 PM
- V ;;4.5;Accounts Receivable;**15,50,59,69,63**;Mar 20, 1995
- TRAN(RCTYNO) ;Pass IFN from 430.3 - returns the transaction type from file 430.3
- N TRAN
- I '$G(RCTYNO) S TRAN="" G TRANQ
- S TRAN=$P($G(^PRCA(430.3,RCTYNO,0)),"^")
- TRANQ Q TRAN
- ;
- STNO(RCTYNO) ;Pass IFN for 430.3 - returns pieces of the 0 node 430.3 where
- ;$P1=Name,$P2=Abbreviation,$P3=Status Number
- N SNDE,STNO,STRG
- I '$G(RCTYNO) S STRG="" G STNOQ
- S SNDE=$G(^PRCA(430.3,+RCTYNO,0)) I SNDE="" S STRG="" G STNOQ
- S STRG=$P($G(SNDE),"^")_"^"_$P($G(SNDE),"^",2)_"^"_$P($G(SNDE),"^",3)
- STNOQ Q STRG
- ;
- STAT(BN) ;Pass in IFN for 430 - returns the IFN for status file 430.3
- N STAT
- I '$G(BN) S STAT="" G STATQ
- S STAT=+$P($G(^PRCA(430,BN,0)),"^",8)
- STATQ Q STAT
- ;
- TRN(BN) ;Pass in IFN for 430 - returns ^TMP array with all transaction
- ;for a bill where I is the transaction number in 433 and
- ;$P1=Transaction Number,$P2=Transaction Date,$P3=Transaction Type
- ;$P4=Transaction Amount,$P5=Amount Due after transaction applied
- ;(Current Balance),$P6=Transaction Comment
- ;Caller must kill ^TMP array
- N BAL,CAT,I,N1,N8,TAMT,TTY
- I '$G(BN) G TRNQ
- K ^TMP("RCJIB",$J)
- S CAT=$$CAT^PRCAFN(BN)
- S BAL=+$P($$BILL(BN),"^")
- S I=0 F S I=$O(^PRCA(433,"C",BN,I)) Q:'I D
- .S N1=$G(^PRCA(433,I,1)),TTY=$P($G(N1),"^",2)
- .S TAMT=$P($G(N1),"^",5)
- .I ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TTY_",") I TAMT'<0 S TAMT=-TAMT
- .I ",2,8,9,10,11,14,19,47,34,35,29,"'[(","_TTY_",") I TAMT<0 S TAMT=-TAMT
- .S N8=$G(^PRCA(433,I,8))
- .I +CAT=33,TTY=1 I TAMT<0 S TAMT=-TAMT
- .I +CAT=33,TTY=35 I TAMT>0 S TAMT=-TAMT
- .I TTY>2,(TTY<7)!(TTY=25) S TAMT=0
- .S BAL=BAL+TAMT
- .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)
- .Q
- TRNQ Q
- ;
- BILL(BN) ;Pass in IFN for 430 - Returns pieces of the 0 node of 430
- ;and pieces of calculated from file 433 where
- ;$P1=Orginal Amount,$P2=Current Status,$P3=Current Balance
- ;$P4=Total Collected,$P5=% Collected
- N BAL,BN0,CST,I,PAY,PER,STRG,TP
- I '$G(BN) S STRG="" G BILLQ
- S BN0=$G(^PRCA(430,BN,0)) I '$G(BN0) S STRG="" G BILLQ
- S CST=$P($G(BN0),"^",8)
- S BAL=$G(^PRCA(430,BN,7)),BAL=$P(BAL,"^")+$P(BAL,"^",2)+$P(BAL,"^",3)+$P(BAL,"^",4)+$P(BAL,"^",5)
- I CST=26 S BAL=0
- I '$G(BN) S STRG="" G TRNQ
- S (I,TP)=0 F S I=$O(^PRCA(433,"C",BN,I)) Q:'I D
- .S PAY=$P($G(^PRCA(433,I,1)),"^",2)
- .I $G(PAY)=2!($G(PAY)=34) S TP=TP+$P($G(^PRCA(433,I,1)),"^",5)
- .Q
- S PER="" I '$P($G(BN0),"^",3)=0 S PER=TP/($P($G(BN0),"^",3))*100
- S STRG=$P($G(BN0),"^",3)_"^"_CST_"^"_BAL_"^"_TP_"^"_PER
- BILLQ Q STRG
- ;
- BCOM(BN) ;Pass in IFN for 430 - Returns COM where $P1=Person who audited and
- ;$P2=Date audited and COM array where COM(I) is the audit comments
- ;Caller must kill COM ARRAY
- N FL,I
- I '$G(BN) S COM="" G BCOMQ
- S COM="",(FL,I)=0 F S I=$O(^PRCA(430,BN,10,I)) Q:I="" D
- .S FL=1,COM(I)=$P($G(^PRCA(430,BN,10,I,0)),"^")
- .Q
- I FL S COM=$P($G(^PRCA(430,BN,9)),"^")_"^"_$P($G(^PRCA(430,BN,9)),"^",3)
- BCOMQ Q
- ;
- DIQ(DA,DR,RCDIQ) ;Return File 430 data from Fileman
- ;DA - IEN, DR - File 430 fields, RCDIQ - Array name
- N D0,DIC,DIQ,DIQ2
- I ($G(^PRCA(430,DA,0))="")!(DR="")!(RCDIQ="") G DIQQ
- S DIQ(0)="IE",DIC="^PRCA(430,",DIQ=RCDIQ
- D EN^DIQ1
- DIQQ Q
- ;
- ;RCJIBFN2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCJIBFN2 3450 printed Jan 18, 2025@02:48:18 Page 2
- RCJIBFN2 ;WASH-ISC@ALTOONA,PA/NYB-FUNC. CALLS FOR JOINT IB/AR ;10/12/95 8:34 AM ; 7/19/96 1:38 PM
- V ;;4.5;Accounts Receivable;**15,50,59,69,63**;Mar 20, 1995
- TRAN(RCTYNO) ;Pass IFN from 430.3 - returns the transaction type from file 430.3
- +1 NEW TRAN
- +2 IF '$GET(RCTYNO)
- SET TRAN=""
- GOTO TRANQ
- +3 SET TRAN=$PIECE($GET(^PRCA(430.3,RCTYNO,0)),"^")
- TRANQ QUIT TRAN
- +1 ;
- STNO(RCTYNO) ;Pass IFN for 430.3 - returns pieces of the 0 node 430.3 where
- +1 ;$P1=Name,$P2=Abbreviation,$P3=Status Number
- +2 NEW SNDE,STNO,STRG
- +3 IF '$GET(RCTYNO)
- SET STRG=""
- GOTO STNOQ
- +4 SET SNDE=$GET(^PRCA(430.3,+RCTYNO,0))
- IF SNDE=""
- SET STRG=""
- GOTO STNOQ
- +5 SET STRG=$PIECE($GET(SNDE),"^")_"^"_$PIECE($GET(SNDE),"^",2)_"^"_$PIECE($GET(SNDE),"^",3)
- STNOQ QUIT STRG
- +1 ;
- STAT(BN) ;Pass in IFN for 430 - returns the IFN for status file 430.3
- +1 NEW STAT
- +2 IF '$GET(BN)
- SET STAT=""
- GOTO STATQ
- +3 SET STAT=+$PIECE($GET(^PRCA(430,BN,0)),"^",8)
- STATQ QUIT STAT
- +1 ;
- TRN(BN) ;Pass in IFN for 430 - returns ^TMP array with all transaction
- +1 ;for a bill where I is the transaction number in 433 and
- +2 ;$P1=Transaction Number,$P2=Transaction Date,$P3=Transaction Type
- +3 ;$P4=Transaction Amount,$P5=Amount Due after transaction applied
- +4 ;(Current Balance),$P6=Transaction Comment
- +5 ;Caller must kill ^TMP array
- +6 NEW BAL,CAT,I,N1,N8,TAMT,TTY
- +7 IF '$GET(BN)
- GOTO TRNQ
- +8 KILL ^TMP("RCJIB",$JOB)
- +9 SET CAT=$$CAT^PRCAFN(BN)
- +10 SET BAL=+$PIECE($$BILL(BN),"^")
- +11 SET I=0
- FOR
- SET I=$ORDER(^PRCA(433,"C",BN,I))
- if 'I
- QUIT
- Begin DoDot:1
- +12 SET N1=$GET(^PRCA(433,I,1))
- SET TTY=$PIECE($GET(N1),"^",2)
- +13 SET TAMT=$PIECE($GET(N1),"^",5)
- +14 IF ",2,8,9,10,11,14,19,47,34,35,29,"[(","_TTY_",")
- IF TAMT'<0
- SET TAMT=-TAMT
- +15 IF ",2,8,9,10,11,14,19,47,34,35,29,"'[(","_TTY_",")
- IF TAMT<0
- SET TAMT=-TAMT
- +16 SET N8=$GET(^PRCA(433,I,8))
- +17 IF +CAT=33
- IF TTY=1
- IF TAMT<0
- SET TAMT=-TAMT
- +18 IF +CAT=33
- IF TTY=35
- IF TAMT>0
- SET TAMT=-TAMT
- +19 IF TTY>2
- IF (TTY<7)!(TTY=25)
- SET TAMT=0
- +20 SET BAL=BAL+TAMT
- +21 SET ^TMP("RCJIB",$JOB,I)=$PIECE($GET(^PRCA(433,I,0)),"^")_"^"_$PIECE($GET(N1),"^")_"^"_$PIECE($GET(N1),"^",2)_"^"_$PIECE($GET(N1),"^",5)_"^"_BAL_"^"_$PIECE($GET(N8),"^",6)
- +22 QUIT
- End DoDot:1
- TRNQ QUIT
- +1 ;
- BILL(BN) ;Pass in IFN for 430 - Returns pieces of the 0 node of 430
- +1 ;and pieces of calculated from file 433 where
- +2 ;$P1=Orginal Amount,$P2=Current Status,$P3=Current Balance
- +3 ;$P4=Total Collected,$P5=% Collected
- +4 NEW BAL,BN0,CST,I,PAY,PER,STRG,TP
- +5 IF '$GET(BN)
- SET STRG=""
- GOTO BILLQ
- +6 SET BN0=$GET(^PRCA(430,BN,0))
- IF '$GET(BN0)
- SET STRG=""
- GOTO BILLQ
- +7 SET CST=$PIECE($GET(BN0),"^",8)
- +8 SET BAL=$GET(^PRCA(430,BN,7))
- SET BAL=$PIECE(BAL,"^")+$PIECE(BAL,"^",2)+$PIECE(BAL,"^",3)+$PIECE(BAL,"^",4)+$PIECE(BAL,"^",5)
- +9 IF CST=26
- SET BAL=0
- +10 IF '$GET(BN)
- SET STRG=""
- GOTO TRNQ
- +11 SET (I,TP)=0
- FOR
- SET I=$ORDER(^PRCA(433,"C",BN,I))
- if 'I
- QUIT
- Begin DoDot:1
- +12 SET PAY=$PIECE($GET(^PRCA(433,I,1)),"^",2)
- +13 IF $GET(PAY)=2!($GET(PAY)=34)
- SET TP=TP+$PIECE($GET(^PRCA(433,I,1)),"^",5)
- +14 QUIT
- End DoDot:1
- +15 SET PER=""
- IF '$PIECE($GET(BN0),"^",3)=0
- SET PER=TP/($PIECE($GET(BN0),"^",3))*100
- +16 SET STRG=$PIECE($GET(BN0),"^",3)_"^"_CST_"^"_BAL_"^"_TP_"^"_PER
- BILLQ QUIT STRG
- +1 ;
- BCOM(BN) ;Pass in IFN for 430 - Returns COM where $P1=Person who audited and
- +1 ;$P2=Date audited and COM array where COM(I) is the audit comments
- +2 ;Caller must kill COM ARRAY
- +3 NEW FL,I
- +4 IF '$GET(BN)
- SET COM=""
- GOTO BCOMQ
- +5 SET COM=""
- SET (FL,I)=0
- FOR
- SET I=$ORDER(^PRCA(430,BN,10,I))
- if I=""
- QUIT
- Begin DoDot:1
- +6 SET FL=1
- SET COM(I)=$PIECE($GET(^PRCA(430,BN,10,I,0)),"^")
- +7 QUIT
- End DoDot:1
- +8 IF FL
- SET COM=$PIECE($GET(^PRCA(430,BN,9)),"^")_"^"_$PIECE($GET(^PRCA(430,BN,9)),"^",3)
- BCOMQ QUIT
- +1 ;
- DIQ(DA,DR,RCDIQ) ;Return File 430 data from Fileman
- +1 ;DA - IEN, DR - File 430 fields, RCDIQ - Array name
- +2 NEW D0,DIC,DIQ,DIQ2
- +3 IF ($GET(^PRCA(430,DA,0))="")!(DR="")!(RCDIQ="")
- GOTO DIQQ
- +4 SET DIQ(0)="IE"
- SET DIC="^PRCA(430,"
- SET DIQ=RCDIQ
- +5 DO EN^DIQ1
- DIQQ QUIT
- +1 ;
- +2 ;RCJIBFN2