RCBEUBIL ;WISC/RFJ-utilties for bills (in file 430) ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**153,226,276,371**;Mar 20, 1995;Build 29
;;Per VHA Directive 6402, this routine should not be modified.
Q
;
;
GETABILL() ; select an active bill
N RCBILLDA,RCCAT,RCCATEG,STATUS
F D Q:RCBILLDA
. W !! S RCBILLDA=$$SELBILL^RCDPBTLM
. I RCBILLDA=0 S RCBILLDA=-1 Q
. I RCBILLDA<1 Q
. ; bill must be active
. S STATUS=$P($G(^PRCA(430,RCBILLDA,0)),"^",8)
. I STATUS'=16,STATUS'=42 W !,"THIS IS NOT AN ACTIVE BILL !",! S RCBILLDA=0 Q
. ;
. ; determine if bill can be adjusted based on category
. K RCCAT D RCCAT^RCRCUTL(.RCCAT) ;returns rccat(category) array
. S RCCATEG=+$P(^PRCA(430,RCBILLDA,0),"^",2)
. I +$G(RCCAT(RCCATEG))=1,$$REFST^RCRCUTL(RCBILLDA) W !!,"YOU CANNOT USE THIS OPTION TO ADJUST REFERRED "_$P($G(RCCAT(RCCATEG)),"^",2)_" BILLS !",! S RCBILLDA=0 Q
. ;
. I RCCATEG=26 W !,"YOU CANNOT ADJUST A PREPAYMENT BILL !",! S RCBILLDA=0 Q
Q RCBILLDA
;
;
EDIT430(RCBILLDA,DR) ; edit the fields in 430 with the DR string passed
I '$D(^PRCA(430,RCBILLDA)) Q
N %,D,D0,D1,DA,DDH,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,J,X,Y
S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
D ^DIE
; user pressed up-arrow
I $D(Y) Q "0^BILL FIELDS NOT UPDATED"
Q 1
;
;
CHGSTAT(RCBILLDA,STATUS) ; change the current status
I '$D(^PRCA(430,RCBILLDA,0)) Q
; if the current status equals the new status, quit
I $P(^PRCA(430,RCBILLDA,0),"^",8)=STATUS Q
; if the status not defined in file 430.3, quit
I '$D(^PRCA(430.3,STATUS,0)) Q
N %,D,D0,DA,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,PREVSTAT,X,Y
S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
; build DR string
S DR=""
; get the current status and set to previous status
S PREVSTAT=$P($G(^PRCA(430,RCBILLDA,0)),"^",8)
; if previous status equal to new status, quit
I PREVSTAT=STATUS Q
I PREVSTAT S DR=DR_"95////"_PREVSTAT_";"
S DR=DR_"8////"_STATUS_";" ;current status
S DR=DR_"17////"_$G(DUZ)_";" ;status updated by
D ^DIE
Q
;
;
SETRCDOJ(RCBILLDA,RCTRANDA,RCDOJ) ; set the bill and transaction to rc or doj
; rcdoj = code RC or DOJ
N D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
S DR="65////"_RCDOJ_";"
D ^DIE
;
S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA
S DR="7////"_RCDOJ_";"
D ^DIE
Q
;
SETBAL(RCTRANDA,RCNFLG) ; set the bills balance by adding value of transaction
N RCBILLDA,RCDATA7,VALUE,RCFDA
S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
; get the value of the transaction
S VALUE=$P($$TRANVALU^RCDPBTLM(RCTRANDA),"^",2,6)
; there is no value on the transaction
I $TR(VALUE,"^0")="" Q
;
S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
; PRCA276 - next line: if adjustment causes negative balance entry in ACCOUNTS RECEIVABLE file not updated
I $P(RCDATA7,"^",1)+$P(VALUE,"^")<0 S RCNFLG=1 Q
; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
S RCFDA(430,RCBILLDA_",",71)=$P(RCDATA7,"^")+$P(VALUE,"^") ; principal
S RCFDA(430,RCBILLDA_",",72)=$P(RCDATA7,"^",2)+$P(VALUE,"^",2) ; interest
S RCFDA(430,RCBILLDA_",",73)=$P(RCDATA7,"^",3)+$P(VALUE,"^",3) ; admin
S RCFDA(430,RCBILLDA_",",74)=$P(RCDATA7,"^",4)+$P(VALUE,"^",4) ; marshal fee
S RCFDA(430,RCBILLDA_",",75)=$P(RCDATA7,"^",5)+$P(VALUE,"^",5) ; court cost
D FILE^DIE(,"RCFDA")
Q
;
FYMULT(RCTRANDA) ; update the fiscal year multiple for bill
; to equal the fiscal year multiple for transaction in file 433
N RCBILLDA,FYDA
S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
S FYDA=0
F S FYDA=$O(^PRCA(433,RCTRANDA,4,FYDA)) Q:'FYDA D
. I $D(^PRCA(430,RCBILLDA,2,FYDA,0)) S $P(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$P(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)
Q
;
;
SHOWBILL(RCBILLDA) ; show data for bill
N DATA7
S DATA7=$G(^PRCA(430,RCBILLDA,7))
W !?8,"Principal Balance: ",$J($P(DATA7,"^"),9,2)
W !?8," Interest Balance: ",$J($P(DATA7,"^",2),9,2)
W !?8," Admin Balance: ",$J($P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),9,2)
W !?27,"---------"
W !?8," TOTAL Balance: ",$J($P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),9,2)
Q
;
;
ADDCOMM(RCBILLDA,COMMENT) ; automatically put a comment on a bill
; comment in the array comment(1)=first line
; comment(2)=second line
N CURRLINE,LINE
; get the last line
S CURRLINE=$O(^PRCA(430,RCBILLDA,10,99999999),-1)
; if comment already on transaction, add a blank line and
; date time of new comment
I CURRLINE D
. S CURRLINE=CURRLINE+1,^PRCA(430,RCBILLDA,10,CURRLINE,0)=" "
. S CURRLINE=CURRLINE+1,^PRCA(430,RCBILLDA,10,CURRLINE,0)="Comment added on: "_$$FMTE^XLFDT($$NOW^XLFDT)
; add new lines
F LINE=1:1 Q:'$D(COMMENT(LINE)) S ^PRCA(430,RCBILLDA,10,CURRLINE+LINE,0)=COMMENT(LINE)
; set the 0th node
S ^PRCA(430,RCBILLDA,10,0)="^^"_(CURRLINE+LINE-1)_"^"_(CURRLINE+LINE-1)_"^"_DT_"^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEUBIL 5026 printed Apr 09, 2024@20:53:07 Page 2
RCBEUBIL ;WISC/RFJ-utilties for bills (in file 430) ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**153,226,276,371**;Mar 20, 1995;Build 29
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
GETABILL() ; select an active bill
+1 NEW RCBILLDA,RCCAT,RCCATEG,STATUS
+2 FOR
Begin DoDot:1
+3 WRITE !!
SET RCBILLDA=$$SELBILL^RCDPBTLM
+4 IF RCBILLDA=0
SET RCBILLDA=-1
QUIT
+5 IF RCBILLDA<1
QUIT
+6 ; bill must be active
+7 SET STATUS=$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",8)
+8 IF STATUS'=16
IF STATUS'=42
WRITE !,"THIS IS NOT AN ACTIVE BILL !",!
SET RCBILLDA=0
QUIT
+9 ;
+10 ; determine if bill can be adjusted based on category
+11 ;returns rccat(category) array
KILL RCCAT
DO RCCAT^RCRCUTL(.RCCAT)
+12 SET RCCATEG=+$PIECE(^PRCA(430,RCBILLDA,0),"^",2)
+13 IF +$GET(RCCAT(RCCATEG))=1
IF $$REFST^RCRCUTL(RCBILLDA)
WRITE !!,"YOU CANNOT USE THIS OPTION TO ADJUST REFERRED "_$PIECE($GET(RCCAT(RCCATEG)),"^",2)_" BILLS !",!
SET RCBILLDA=0
QUIT
+14 ;
+15 IF RCCATEG=26
WRITE !,"YOU CANNOT ADJUST A PREPAYMENT BILL !",!
SET RCBILLDA=0
QUIT
End DoDot:1
if RCBILLDA
QUIT
+16 QUIT RCBILLDA
+17 ;
+18 ;
EDIT430(RCBILLDA,DR) ; edit the fields in 430 with the DR string passed
+1 IF '$DATA(^PRCA(430,RCBILLDA))
QUIT
+2 NEW %,D,D0,D1,DA,DDH,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,J,X,Y
+3 SET (DIC,DIE)="^PRCA(430,"
SET DA=RCBILLDA
+4 DO ^DIE
+5 ; user pressed up-arrow
+6 IF $DATA(Y)
QUIT "0^BILL FIELDS NOT UPDATED"
+7 QUIT 1
+8 ;
+9 ;
CHGSTAT(RCBILLDA,STATUS) ; change the current status
+1 IF '$DATA(^PRCA(430,RCBILLDA,0))
QUIT
+2 ; if the current status equals the new status, quit
+3 IF $PIECE(^PRCA(430,RCBILLDA,0),"^",8)=STATUS
QUIT
+4 ; if the status not defined in file 430.3, quit
+5 IF '$DATA(^PRCA(430.3,STATUS,0))
QUIT
+6 NEW %,D,D0,DA,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,PREVSTAT,X,Y
+7 SET (DIC,DIE)="^PRCA(430,"
SET DA=RCBILLDA
+8 ; build DR string
+9 SET DR=""
+10 ; get the current status and set to previous status
+11 SET PREVSTAT=$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",8)
+12 ; if previous status equal to new status, quit
+13 IF PREVSTAT=STATUS
QUIT
+14 IF PREVSTAT
SET DR=DR_"95////"_PREVSTAT_";"
+15 ;current status
SET DR=DR_"8////"_STATUS_";"
+16 ;status updated by
SET DR=DR_"17////"_$GET(DUZ)_";"
+17 DO ^DIE
+18 QUIT
+19 ;
+20 ;
SETRCDOJ(RCBILLDA,RCTRANDA,RCDOJ) ; set the bill and transaction to rc or doj
+1 ; rcdoj = code RC or DOJ
+2 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
+3 SET (DIC,DIE)="^PRCA(430,"
SET DA=RCBILLDA
+4 SET DR="65////"_RCDOJ_";"
+5 DO ^DIE
+6 ;
+7 SET (DIC,DIE)="^PRCA(433,"
SET DA=RCTRANDA
+8 SET DR="7////"_RCDOJ_";"
+9 DO ^DIE
+10 QUIT
+11 ;
SETBAL(RCTRANDA,RCNFLG) ; set the bills balance by adding value of transaction
+1 NEW RCBILLDA,RCDATA7,VALUE,RCFDA
+2 SET RCBILLDA=$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
IF 'RCBILLDA
QUIT
+3 ; get the value of the transaction
+4 SET VALUE=$PIECE($$TRANVALU^RCDPBTLM(RCTRANDA),"^",2,6)
+5 ; there is no value on the transaction
+6 IF $TRANSLATE(VALUE,"^0")=""
QUIT
+7 ;
+8 SET RCDATA7=$GET(^PRCA(430,RCBILLDA,7))
+9 ; PRCA276 - next line: if adjustment causes negative balance entry in ACCOUNTS RECEIVABLE file not updated
+10 IF $PIECE(RCDATA7,"^",1)+$PIECE(VALUE,"^")<0
SET RCNFLG=1
QUIT
+11 ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
+12 ; principal
SET RCFDA(430,RCBILLDA_",",71)=$PIECE(RCDATA7,"^")+$PIECE(VALUE,"^")
+13 ; interest
SET RCFDA(430,RCBILLDA_",",72)=$PIECE(RCDATA7,"^",2)+$PIECE(VALUE,"^",2)
+14 ; admin
SET RCFDA(430,RCBILLDA_",",73)=$PIECE(RCDATA7,"^",3)+$PIECE(VALUE,"^",3)
+15 ; marshal fee
SET RCFDA(430,RCBILLDA_",",74)=$PIECE(RCDATA7,"^",4)+$PIECE(VALUE,"^",4)
+16 ; court cost
SET RCFDA(430,RCBILLDA_",",75)=$PIECE(RCDATA7,"^",5)+$PIECE(VALUE,"^",5)
+17 DO FILE^DIE(,"RCFDA")
+18 QUIT
+19 ;
FYMULT(RCTRANDA) ; update the fiscal year multiple for bill
+1 ; to equal the fiscal year multiple for transaction in file 433
+2 NEW RCBILLDA,FYDA
+3 SET RCBILLDA=$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
IF 'RCBILLDA
QUIT
+4 SET FYDA=0
+5 FOR
SET FYDA=$ORDER(^PRCA(433,RCTRANDA,4,FYDA))
if 'FYDA
QUIT
Begin DoDot:1
+6 IF $DATA(^PRCA(430,RCBILLDA,2,FYDA,0))
SET $PIECE(^PRCA(430,RCBILLDA,2,FYDA,0),"^",2)=$PIECE(^PRCA(433,RCTRANDA,4,FYDA,0),"^",2)
End DoDot:1
+7 QUIT
+8 ;
+9 ;
SHOWBILL(RCBILLDA) ; show data for bill
+1 NEW DATA7
+2 SET DATA7=$GET(^PRCA(430,RCBILLDA,7))
+3 WRITE !?8,"Principal Balance: ",$JUSTIFY($PIECE(DATA7,"^"),9,2)
+4 WRITE !?8," Interest Balance: ",$JUSTIFY($PIECE(DATA7,"^",2),9,2)
+5 WRITE !?8," Admin Balance: ",$JUSTIFY($PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5),9,2)
+6 WRITE !?27,"---------"
+7 WRITE !?8," TOTAL Balance: ",$JUSTIFY($PIECE(DATA7,"^")+$PIECE(DATA7,"^",2)+$PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5),9,2)
+8 QUIT
+9 ;
+10 ;
ADDCOMM(RCBILLDA,COMMENT) ; automatically put a comment on a bill
+1 ; comment in the array comment(1)=first line
+2 ; comment(2)=second line
+3 NEW CURRLINE,LINE
+4 ; get the last line
+5 SET CURRLINE=$ORDER(^PRCA(430,RCBILLDA,10,99999999),-1)
+6 ; if comment already on transaction, add a blank line and
+7 ; date time of new comment
+8 IF CURRLINE
Begin DoDot:1
+9 SET CURRLINE=CURRLINE+1
SET ^PRCA(430,RCBILLDA,10,CURRLINE,0)=" "
+10 SET CURRLINE=CURRLINE+1
SET ^PRCA(430,RCBILLDA,10,CURRLINE,0)="Comment added on: "_$$FMTE^XLFDT($$NOW^XLFDT)
End DoDot:1
+11 ; add new lines
+12 FOR LINE=1:1
if '$DATA(COMMENT(LINE))
QUIT
SET ^PRCA(430,RCBILLDA,10,CURRLINE+LINE,0)=COMMENT(LINE)
+13 ; set the 0th node
+14 SET ^PRCA(430,RCBILLDA,10,0)="^^"_(CURRLINE+LINE-1)_"^"_(CURRLINE+LINE-1)_"^"_DT_"^"
+15 QUIT
