Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBEUBIL

RCBEUBIL.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. GETABILL() ; select an active bill
  1. N RCBILLDA,RCCAT,RCCATEG,STATUS
  1. F D Q:RCBILLDA
  1. . W !! S RCBILLDA=$$SELBILL^RCDPBTLM
  1. . I RCBILLDA=0 S RCBILLDA=-1 Q
  1. . I RCBILLDA<1 Q
  1. . ; bill must be active
  1. . S STATUS=$P($G(^PRCA(430,RCBILLDA,0)),"^",8)
  1. . I STATUS'=16,STATUS'=42 W !,"THIS IS NOT AN ACTIVE BILL !",! S RCBILLDA=0 Q
  1. . ;
  1. . ; determine if bill can be adjusted based on category
  1. . K RCCAT D RCCAT^RCRCUTL(.RCCAT) ;returns rccat(category) array
  1. . S RCCATEG=+$P(^PRCA(430,RCBILLDA,0),"^",2)
  1. . 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
  1. . ;
  1. . I RCCATEG=26 W !,"YOU CANNOT ADJUST A PREPAYMENT BILL !",! S RCBILLDA=0 Q
  1. Q RCBILLDA
  1. ;
  1. ;
  1. EDIT430(RCBILLDA,DR) ; edit the fields in 430 with the DR string passed
  1. I '$D(^PRCA(430,RCBILLDA)) Q
  1. N %,D,D0,D1,DA,DDH,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,J,X,Y
  1. S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
  1. D ^DIE
  1. ; user pressed up-arrow
  1. I $D(Y) Q "0^BILL FIELDS NOT UPDATED"
  1. Q 1
  1. ;
  1. ;
  1. CHGSTAT(RCBILLDA,STATUS) ; change the current status
  1. I '$D(^PRCA(430,RCBILLDA,0)) Q
  1. ; if the current status equals the new status, quit
  1. I $P(^PRCA(430,RCBILLDA,0),"^",8)=STATUS Q
  1. ; if the status not defined in file 430.3, quit
  1. I '$D(^PRCA(430.3,STATUS,0)) Q
  1. N %,D,D0,DA,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,PREVSTAT,X,Y
  1. S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
  1. ; build DR string
  1. S DR=""
  1. ; get the current status and set to previous status
  1. S PREVSTAT=$P($G(^PRCA(430,RCBILLDA,0)),"^",8)
  1. ; if previous status equal to new status, quit
  1. I PREVSTAT=STATUS Q
  1. I PREVSTAT S DR=DR_"95////"_PREVSTAT_";"
  1. S DR=DR_"8////"_STATUS_";" ;current status
  1. S DR=DR_"17////"_$G(DUZ)_";" ;status updated by
  1. D ^DIE
  1. Q
  1. ;
  1. ;
  1. SETRCDOJ(RCBILLDA,RCTRANDA,RCDOJ) ; set the bill and transaction to rc or doj
  1. ; rcdoj = code RC or DOJ
  1. N D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
  1. S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA
  1. S DR="65////"_RCDOJ_";"
  1. D ^DIE
  1. ;
  1. S (DIC,DIE)="^PRCA(433,",DA=RCTRANDA
  1. S DR="7////"_RCDOJ_";"
  1. D ^DIE
  1. Q
  1. ;
  1. SETBAL(RCTRANDA,RCNFLG) ; set the bills balance by adding value of transaction
  1. N RCBILLDA,RCDATA7,VALUE,RCFDA
  1. S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
  1. ; get the value of the transaction
  1. S VALUE=$P($$TRANVALU^RCDPBTLM(RCTRANDA),"^",2,6)
  1. ; there is no value on the transaction
  1. I $TR(VALUE,"^0")="" Q
  1. ;
  1. S RCDATA7=$G(^PRCA(430,RCBILLDA,7))
  1. ; PRCA276 - next line: if adjustment causes negative balance entry in ACCOUNTS RECEIVABLE file not updated
  1. I $P(RCDATA7,"^",1)+$P(VALUE,"^")<0 S RCNFLG=1 Q
  1. ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
  1. S RCFDA(430,RCBILLDA_",",71)=$P(RCDATA7,"^")+$P(VALUE,"^") ; principal
  1. S RCFDA(430,RCBILLDA_",",72)=$P(RCDATA7,"^",2)+$P(VALUE,"^",2) ; interest
  1. S RCFDA(430,RCBILLDA_",",73)=$P(RCDATA7,"^",3)+$P(VALUE,"^",3) ; admin
  1. S RCFDA(430,RCBILLDA_",",74)=$P(RCDATA7,"^",4)+$P(VALUE,"^",4) ; marshal fee
  1. S RCFDA(430,RCBILLDA_",",75)=$P(RCDATA7,"^",5)+$P(VALUE,"^",5) ; court cost
  1. D FILE^DIE(,"RCFDA")
  1. Q
  1. ;
  1. FYMULT(RCTRANDA) ; update the fiscal year multiple for bill
  1. ; to equal the fiscal year multiple for transaction in file 433
  1. N RCBILLDA,FYDA
  1. S RCBILLDA=$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA Q
  1. S FYDA=0
  1. F S FYDA=$O(^PRCA(433,RCTRANDA,4,FYDA)) Q:'FYDA D
  1. . 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)
  1. Q
  1. ;
  1. ;
  1. SHOWBILL(RCBILLDA) ; show data for bill
  1. N DATA7
  1. S DATA7=$G(^PRCA(430,RCBILLDA,7))
  1. W !?8,"Principal Balance: ",$J($P(DATA7,"^"),9,2)
  1. W !?8," Interest Balance: ",$J($P(DATA7,"^",2),9,2)
  1. W !?8," Admin Balance: ",$J($P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),9,2)
  1. W !?27,"---------"
  1. W !?8," TOTAL Balance: ",$J($P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),9,2)
  1. Q
  1. ;
  1. ;
  1. ADDCOMM(RCBILLDA,COMMENT) ; automatically put a comment on a bill
  1. ; comment in the array comment(1)=first line
  1. ; comment(2)=second line
  1. N CURRLINE,LINE
  1. ; get the last line
  1. S CURRLINE=$O(^PRCA(430,RCBILLDA,10,99999999),-1)
  1. ; if comment already on transaction, add a blank line and
  1. ; date time of new comment
  1. I CURRLINE D
  1. . S CURRLINE=CURRLINE+1,^PRCA(430,RCBILLDA,10,CURRLINE,0)=" "
  1. . S CURRLINE=CURRLINE+1,^PRCA(430,RCBILLDA,10,CURRLINE,0)="Comment added on: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1. ; add new lines
  1. F LINE=1:1 Q:'$D(COMMENT(LINE)) S ^PRCA(430,RCBILLDA,10,CURRLINE+LINE,0)=COMMENT(LINE)
  1. ; set the 0th node
  1. S ^PRCA(430,RCBILLDA,10,0)="^^"_(CURRLINE+LINE-1)_"^"_(CURRLINE+LINE-1)_"^"_DT_"^"
  1. Q