- 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 Feb 18, 2025@23:06:25 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