- 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 Jan 18, 2025@02:44: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