PRCAI168 ;WISC/RFJ-post init patch 168 ; 26 Jan 01
;;4.5;Accounts Receivable;**168**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
START ; start post init
; track int, admin write offs on the write off 433 transaction
;
D BMES^XPDUTL(" >> Checking write-off transactions ...")
;
N DATA7,DATA8,NEXTTRAN,P,PRIN,RCBILLDA,RCDATE,RCTRANDA,RCTRTYPE
;
; 8 = TERM.BY FIS.OFFICER
; 9 = TERM.BY COMPROMISE
; 10 = WAIVED IN FULL
; 11 = WAIVED IN PART
; 29 = TERM BY RC/DOJ
F RCTRTYPE=8,9,10,11,29 S RCDATE=0 F S RCDATE=$O(^PRCA(433,"AT",RCTRTYPE,RCDATE)) Q:'RCDATE D
. S RCTRANDA=0 F S RCTRANDA=$O(^PRCA(433,"AT",RCTRTYPE,RCDATE,RCTRANDA)) Q:'RCTRANDA D
. . ; if transaction status not valid, quit
. . I '$$VALID^RCRJRCOT(RCTRANDA) Q
. . ;
. . L +^PRCA(433,RCTRANDA)
. . ;
. . S DATA8=$G(^PRCA(433,RCTRANDA,8))
. . S PRIN=$P(DATA8,"^") I 'PRIN S PRIN=$$TRANAMT^RCRJRCOT(RCTRANDA),$P(DATA8,"^")=PRIN
. . ;
. . S RCBILLDA=+$P($G(^PRCA(433,RCTRANDA,0)),"^",2) I 'RCBILLDA L -^PRCA(433,RCTRANDA) Q
. . S DATA7=$P($G(^PRCA(430,RCBILLDA,7)),"^",1,5)
. . ;
. . ; if the termination is not the last transaction, find the next re-establish transaction
. . ; to determine the interest and admin
. . I $O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) D
. . . S NEXTTRAN=RCTRANDA F S NEXTTRAN=$O(^PRCA(433,"C",RCBILLDA,NEXTTRAN)) Q:'NEXTTRAN I $P($G(^PRCA(433,NEXTTRAN,1)),"^",2)=43 Q
. . . I 'NEXTTRAN Q
. . . F P=2:1:5 S $P(DATA8,"^",P)=+$P($G(^PRCA(433,NEXTTRAN,8)),"^",P)
. . ;
. . ; move over int, admin, mf, cc
. . I '$O(^PRCA(433,"C",RCBILLDA,RCTRANDA)) F P=2:1:5 S $P(DATA8,"^",P)=+$P(DATA7,"^",P)
. . ;
. . F P=1:1:5 I $P(DATA8,"^",P),(+$P(DATA8,"^",P)'=+$P($G(^PRCA(433,RCTRANDA,8)),"^",P)) D
. . . S $P(^PRCA(433,RCTRANDA,8),"^",P)=+$P(DATA8,"^",P)
. . ;
. . L -^PRCA(433,RCTRANDA)
;
D MES^XPDUTL(" OK, done.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAI168 2053 printed Apr 09, 2024@20:53:26 Page 2
PRCAI168 ;WISC/RFJ-post init patch 168 ; 26 Jan 01
+1 ;;4.5;Accounts Receivable;**168**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
START ; start post init
+1 ; track int, admin write offs on the write off 433 transaction
+2 ;
+3 DO BMES^XPDUTL(" >> Checking write-off transactions ...")
+4 ;
+5 NEW DATA7,DATA8,NEXTTRAN,P,PRIN,RCBILLDA,RCDATE,RCTRANDA,RCTRTYPE
+6 ;
+7 ; 8 = TERM.BY FIS.OFFICER
+8 ; 9 = TERM.BY COMPROMISE
+9 ; 10 = WAIVED IN FULL
+10 ; 11 = WAIVED IN PART
+11 ; 29 = TERM BY RC/DOJ
+12 FOR RCTRTYPE=8,9,10,11,29
SET RCDATE=0
FOR
SET RCDATE=$ORDER(^PRCA(433,"AT",RCTRTYPE,RCDATE))
if 'RCDATE
QUIT
Begin DoDot:1
+13 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^PRCA(433,"AT",RCTRTYPE,RCDATE,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+14 ; if transaction status not valid, quit
+15 IF '$$VALID^RCRJRCOT(RCTRANDA)
QUIT
+16 ;
+17 LOCK +^PRCA(433,RCTRANDA)
+18 ;
+19 SET DATA8=$GET(^PRCA(433,RCTRANDA,8))
+20 SET PRIN=$PIECE(DATA8,"^")
IF 'PRIN
SET PRIN=$$TRANAMT^RCRJRCOT(RCTRANDA)
SET $PIECE(DATA8,"^")=PRIN
+21 ;
+22 SET RCBILLDA=+$PIECE($GET(^PRCA(433,RCTRANDA,0)),"^",2)
IF 'RCBILLDA
LOCK -^PRCA(433,RCTRANDA)
QUIT
+23 SET DATA7=$PIECE($GET(^PRCA(430,RCBILLDA,7)),"^",1,5)
+24 ;
+25 ; if the termination is not the last transaction, find the next re-establish transaction
+26 ; to determine the interest and admin
+27 IF $ORDER(^PRCA(433,"C",RCBILLDA,RCTRANDA))
Begin DoDot:3
+28 SET NEXTTRAN=RCTRANDA
FOR
SET NEXTTRAN=$ORDER(^PRCA(433,"C",RCBILLDA,NEXTTRAN))
if 'NEXTTRAN
QUIT
IF $PIECE($GET(^PRCA(433,NEXTTRAN,1)),"^",2)=43
QUIT
+29 IF 'NEXTTRAN
QUIT
+30 FOR P=2:1:5
SET $PIECE(DATA8,"^",P)=+$PIECE($GET(^PRCA(433,NEXTTRAN,8)),"^",P)
End DoDot:3
+31 ;
+32 ; move over int, admin, mf, cc
+33 IF '$ORDER(^PRCA(433,"C",RCBILLDA,RCTRANDA))
FOR P=2:1:5
SET $PIECE(DATA8,"^",P)=+$PIECE(DATA7,"^",P)
+34 ;
+35 FOR P=1:1:5
IF $PIECE(DATA8,"^",P)
IF (+$PIECE(DATA8,"^",P)'=+$PIECE($GET(^PRCA(433,RCTRANDA,8)),"^",P))
Begin DoDot:3
+36 SET $PIECE(^PRCA(433,RCTRANDA,8),"^",P)=+$PIECE(DATA8,"^",P)
End DoDot:3
+37 ;
+38 LOCK -^PRCA(433,RCTRANDA)
End DoDot:2
End DoDot:1
+39 ;
+40 DO MES^XPDUTL(" OK, done.")
+41 QUIT
