- RCBEPAYF ;WISC/RFJ-first party payment processing(called by rcbepay) ;1 Jun 00
- ;;4.5;Accounts Receivable;**153,301,322,315**;Mar 20, 1995;Build 67
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- ;PRCA*4.5*322 Awaken commented line to post payemnt to
- ; implied bill# for receipt payment
- ;
- FIRSTPTY() ; apply payment to first party account
- ; called by rcbepay
- N PAYMENT,RCBILBAL,RCBILLDA,RCDATE,RCDEBTDA,RCERROR,RCREPAMT,RCSTATUS,RCTRANDA,X,CSBILL,CSBILLDA,CSDEP,IDX,PREV
- K ^TMP("RCBEPAY",$J)
- ; acc't lookup info BB prca*4.5*301
- S CSBILLDA=+$E($P(RCDATA,"^",7),22,99),CSDEP=$P(RCDATA,"^",19),CSBILL=$E($P(RCDATA,"^",7),1,3)_"-"_$E($P(RCDATA,"^",7),4,10)
- I 'CSDEP S CSDEP=169 ;Default for missing pay type
- I $E($G(CSDEP),1,3)=170 S CSBILLDA=$O(^PRCA(430,"B",CSBILL,0))
- I RCDATA["PRCA(430," S CSBILLDA=+$P(RCDATA,"^",3)
- I CSDEP>167,CSDEP<171 S RCBETYPE=CSDEP
- ;end PRCA*4.5*301
- ;
- ; look up account in debtor file
- S RCDEBTDA=$$DEBT^RCEVUTL(RCACCT)
- I RCDEBTDA<0 Q "1^Could not add Patient ("_RCACCT_") to debtor file"
- ;
- ; lock the debtor account
- L +^RCD(340,RCDEBTDA):20 I '$T Q "1^Another user is working with this patient account"
- ;
- ; build list of active(16) and open(42) bills for patient
- ; sorted by date bill prepared
- F RCSTATUS=16,42 S RCBILLDA=0 F S RCBILLDA=$O(^PRCA(430,"AS",RCDEBTDA,RCSTATUS,RCBILLDA)) Q:'RCBILLDA D
- . ; check bill for prepayment
- . I $P(^PRCA(430,RCBILLDA,0),"^",2)=26 Q ; ACCOUNTS RECEIVABLE CATEGORY (PREPAYMENT=26)
- . ;
- . ; checks if payment was via a "170" CS Treasury lockbox transaction ; prca*4.5*301
- . ; Ignores bill if bill is NOT a "TCSP" CS bill
- . ; else sets as FIRST if designated as bill to be applied, or subsequent in oldest date order
- . I CSDEP=170 D Q ; prca*4.5*301
- . . I $D(^PRCA(430,"TCSP",RCBILLDA)) D Q ;
- . . . I CSBILLDA=RCBILLDA S ^TMP("RCBEPAY",$J,0,RCBILLDA)="" Q
- . . . S ^TMP("RCBEPAY",$J,880000000+$P($G(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
- . . S ^TMP("RCBEPAY",$J,990000000+$P($G(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
- . I $E($G(CSDEP),1,3)'=168,$D(^PRCA(430,"TCSP",RCBILLDA)) Q ;BB prca*4.5*301
- . I CSBILLDA=RCBILLDA S ^TMP("RCBEPAY",$J,0,RCBILLDA)="" Q ;PRCA*4.5*322
- . S ^TMP("RCBEPAY",$J,+$P($G(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
- PROC ;
- ; loop all the bills for a patients account and keep looping them
- ; until either there is no more bills or the money paid is zero.
- ; the bills are looped in case of repayments. if there is money
- ; left over, this will apply more money to the repayment bills
- ; instead of creating a prepayment. a prepayment should only be
- ; created if all bills for the account is collected/closed.
- S RCERROR=0
- ; quit the loop if no money left to apply OR an error occurred OR
- ; no more bills left to apply payment to
- F D I 'RCPAYAMT!(RCERROR)!($O(^TMP("RCBEPAY",$J,""))="") Q
- . ; loop the bills by date prepared and apply the payment
- . ; quit if no money left to apply OR and error occurred
- . S RCDATE="" F S RCDATE=$O(^TMP("RCBEPAY",$J,RCDATE)) Q:RCDATE="" D I 'RCPAYAMT!(RCERROR) Q
- . . S RCBILLDA=0 F S RCBILLDA=$O(^TMP("RCBEPAY",$J,RCDATE,RCBILLDA)) Q:'RCBILLDA D I 'RCPAYAMT!(RCERROR) Q
- . . . L +^PRCA(430,RCBILLDA):10
- . . . I '$T S RCERROR="1^Another user is working with bill "_$P(^PRCA(430,RCBILLDA,0),"^") Q
- . . . ;
- . . . ; exempt any interest/admin/penalty charges added on or after
- . . . ; the payment date
- . . . D EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
- . . . ;
- . . . ; get the repayment amount (if any)
- . . . S RCREPAMT=$P($G(^PRCA(430,RCBILLDA,4)),"^",3) I CSDEP=168!(CSDEP=170) S RCREPAMT=0 ;PRCA*4.5*301
- . . . ;
- . . . ; get the balance of the bill
- . . . S X=$G(^PRCA(430,RCBILLDA,7))
- . . . S RCBILBAL=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
- . . . ; if bill has no balance, chg status = collected/closed
- . . . I 'RCBILBAL D Q ;PRCA*4.5*301
- . . . . D CHGSTAT^RCBEUBIL(RCBILLDA,22)
- . . . . L -^PRCA(430,RCBILLDA)
- . . . . K ^TMP("RCBEPAY",$J,RCDATE,RCBILLDA)
- . . . ;
- . . . ; determine amount to pay
- . . . ; if the payment is greater than billed amount, pay billed amount
- . . . ; if there is a repayment amount, pay the repayment amount
- . . . ; do not allow payment to exceed amount paid
- . . . S PAYMENT=RCPAYAMT
- . . . I PAYMENT>RCBILBAL S PAYMENT=RCBILBAL
- . . . I RCREPAMT S PAYMENT=RCREPAMT I PAYMENT>RCBILBAL S PAYMENT=RCBILBAL
- . . . I PAYMENT>RCPAYAMT S PAYMENT=RCPAYAMT
- . . . ;
- . . . ; apply payment to bill
- . . . ; return error if problem adding payment transaction
- . . . S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,PAYMENT,RCRECTDA,RCPAYDA,RCPAYDAT)
- . . . I 'RCTRANDA L -^PRCA(430,RCBILLDA) S RCERROR="1^"_$P(RCTRANDA,"^",2) Q
- . . . ;
- . . . ; payment applied to bill, subtract off the payment amount
- . . . S RCPAYAMT=RCPAYAMT-$P($G(^PRCA(433,RCTRANDA,1)),"^",5)
- . . . ;
- . . . ; set the amount processed on the receipt payment
- . . . D SETAMT^RCBEPAY(RCRECTDA,RCPAYDA,$P($G(^PRCA(433,RCTRANDA,1)),"^",5))
- . . . ;
- . . . ; if Bill is Cross-Serviced, then create DECREASED ADJUSTMENT for 5B reporting
- . . . I $E($G(CSDEP),1,3)=168,$D(^PRCA(430,"TCSP",RCBILLDA)) D CS5B(RCBILLDA) ; BB prca*4.5*301
- . . . I $E($G(CSDEP),1,3)=170,RCBILLDA'=CSBILLDA,$D(^PRCA(430,"TCSP",RCBILLDA)) D CS5B(RCBILLDA) ; BB prca*4.5*301
- . . . ;
- . . . ; get the new balance of the bill. if it is zero
- . . . ; remove it from the tmp global (this will stop the
- . . . ; loop if dollars are left and no bills are active)
- . . . S X=$G(^PRCA(430,RCBILLDA,7))
- . . . S RCBILBAL=$P(X,"^")+$P(X,"^",2)+$P(X,"^",3)+$P(X,"^",4)+$P(X,"^",5)
- . . . I 'RCBILBAL D ;PRCA*4.5*301
- . . . . D CHGSTAT^RCBEUBIL(RCBILLDA,22)
- . . . . K ^TMP("RCBEPAY",$J,RCDATE,RCBILLDA)
- . . . . I $D(^PRCA(430,"TCSP",RCBILLDA)),RCBILLDA=CSBILLDA S $P(^PRCA(430,RCBILLDA,15),"^")="" K ^PRCA(430,"TCSP",RCBILLDA) ;S DA=RCBILLDA,DIE="^PRCA(430,",DR="151////@" D ^DIE K DIE,DA,DR
- . . . ;
- . . . L -^PRCA(430,RCBILLDA)
- ;
- K ^TMP("RCBEPAY",$J)
- ;
- ; if an error occurred, quit
- I RCERROR L -^RCD(340,RCDEBTDA) Q RCERROR
- ;
- ; if no money left, quit
- I 'RCPAYAMT L -^RCD(340,RCDEBTDA) Q 0
- ;
- ; dollars remaining, create a prepayment
- N %,%H,%I,%X,D,D0,DFN,DI,DIC,DICR,DIG,DIH,DIU,DIV,DIW,DQ,I,PRCA,RCREF,VA,VADM
- D EN^PRCAPAY3(RCACCT,RCPAYAMT,RCPAYDAT,DUZ,$P(^RCY(344,RCRECTDA,0),"^"),"","",.RCERROR,"")
- ; no errors
- I RCERROR=""!(RCERROR=0) D
- . S RCERROR=0
- . ; set the amount processed on the receipt
- . D SETAMT^RCBEPAY(RCRECTDA,RCPAYDA,RCPAYAMT)
- ; error creating prepayment
- I RCERROR'=0 S RCERROR="1^"_RCERROR
- ;
- L -^RCD(340,RCDEBTDA)
- Q RCERROR
- ;
- CS5B(RCBILLDA) ; logs ADJ for 5B CS reporting if Cross-Serviced bill ; prca*4.5*301 ; LEG
- ; Changed description from DEC ADJ to ADJ since increase adjustments will also use this code 315/DRF
- ; note: can use either I +$G(^PRCA(430,RCBILLDA,15)) D ; bill is Cross-Serviced
- I $D(^PRCA(430,"TCSP",RCBILLDA)) D ; bill is Cross-Serviced
- . ; checks for valid bill
- . S DIC="^PRCA(430,",DIC(0)="KMNZ",X=RCBILLDA D ^DIC
- . ; checks if DEC ADJ record was previously logged
- . S IDX=0,PREV=0
- . F S IDX=$O(^PRCA(430,RCBILLDA,17,IDX)) Q:'IDX D ;
- . . I +$G(^PRCA(430,RCBILLDA,17,IDX,0))=RCTRANDA S PREV=1
- . I PREV Q ; transaction was already logged
- . ;
- . ; gets next ADJ subfile entry number or creates 1st
- . K DR,DA,DD,DO,DIC,DIE
- . S X=RCTRANDA ; CS ADJ TRANS NUMBER
- . S DA(1)=RCBILLDA
- . S DIC="^PRCA(430,"_DA(1)_",17,"
- . S DIC(0)="KLMNZ"
- . S DIC("P")=$P(^DD(430,171,0),"^",2)
- . D ^DIC
- . ; set ADJ Fields
- . S DIE=DIC K DIC
- . S DA=+Y
- . S DR="1////1" ; SEND TCSP RECORD 5B
- . S DIC("DR")=DR
- . D ^DIE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEPAYF 8189 printed Feb 18, 2025@23:09:13 Page 2
- RCBEPAYF ;WISC/RFJ-first party payment processing(called by rcbepay) ;1 Jun 00
- +1 ;;4.5;Accounts Receivable;**153,301,322,315**;Mar 20, 1995;Build 67
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;PRCA*4.5*322 Awaken commented line to post payemnt to
- +6 ; implied bill# for receipt payment
- +7 ;
- FIRSTPTY() ; apply payment to first party account
- +1 ; called by rcbepay
- +2 NEW PAYMENT,RCBILBAL,RCBILLDA,RCDATE,RCDEBTDA,RCERROR,RCREPAMT,RCSTATUS,RCTRANDA,X,CSBILL,CSBILLDA,CSDEP,IDX,PREV
- +3 KILL ^TMP("RCBEPAY",$JOB)
- +4 ; acc't lookup info BB prca*4.5*301
- +5 SET CSBILLDA=+$EXTRACT($PIECE(RCDATA,"^",7),22,99)
- SET CSDEP=$PIECE(RCDATA,"^",19)
- SET CSBILL=$EXTRACT($PIECE(RCDATA,"^",7),1,3)_"-"_$EXTRACT($PIECE(RCDATA,"^",7),4,10)
- +6 ;Default for missing pay type
- IF 'CSDEP
- SET CSDEP=169
- +7 IF $EXTRACT($GET(CSDEP),1,3)=170
- SET CSBILLDA=$ORDER(^PRCA(430,"B",CSBILL,0))
- +8 IF RCDATA["PRCA(430,"
- SET CSBILLDA=+$PIECE(RCDATA,"^",3)
- +9 IF CSDEP>167
- IF CSDEP<171
- SET RCBETYPE=CSDEP
- +10 ;end PRCA*4.5*301
- +11 ;
- +12 ; look up account in debtor file
- +13 SET RCDEBTDA=$$DEBT^RCEVUTL(RCACCT)
- +14 IF RCDEBTDA<0
- QUIT "1^Could not add Patient ("_RCACCT_") to debtor file"
- +15 ;
- +16 ; lock the debtor account
- +17 LOCK +^RCD(340,RCDEBTDA):20
- IF '$TEST
- QUIT "1^Another user is working with this patient account"
- +18 ;
- +19 ; build list of active(16) and open(42) bills for patient
- +20 ; sorted by date bill prepared
- +21 FOR RCSTATUS=16,42
- SET RCBILLDA=0
- FOR
- SET RCBILLDA=$ORDER(^PRCA(430,"AS",RCDEBTDA,RCSTATUS,RCBILLDA))
- if 'RCBILLDA
- QUIT
- Begin DoDot:1
- +22 ; check bill for prepayment
- +23 ; ACCOUNTS RECEIVABLE CATEGORY (PREPAYMENT=26)
- IF $PIECE(^PRCA(430,RCBILLDA,0),"^",2)=26
- QUIT
- +24 ;
- +25 ; checks if payment was via a "170" CS Treasury lockbox transaction ; prca*4.5*301
- +26 ; Ignores bill if bill is NOT a "TCSP" CS bill
- +27 ; else sets as FIRST if designated as bill to be applied, or subsequent in oldest date order
- +28 ; prca*4.5*301
- IF CSDEP=170
- Begin DoDot:2
- +29 ;
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- Begin DoDot:3
- +30 IF CSBILLDA=RCBILLDA
- SET ^TMP("RCBEPAY",$JOB,0,RCBILLDA)=""
- QUIT
- +31 SET ^TMP("RCBEPAY",$JOB,880000000+$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
- End DoDot:3
- QUIT
- +32 SET ^TMP("RCBEPAY",$JOB,990000000+$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
- End DoDot:2
- QUIT
- +33 ;BB prca*4.5*301
- IF $EXTRACT($GET(CSDEP),1,3)'=168
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- QUIT
- +34 ;PRCA*4.5*322
- IF CSBILLDA=RCBILLDA
- SET ^TMP("RCBEPAY",$JOB,0,RCBILLDA)=""
- QUIT
- +35 SET ^TMP("RCBEPAY",$JOB,+$PIECE($GET(^PRCA(430,RCBILLDA,0)),"^",10),RCBILLDA)=""
- End DoDot:1
- PROC ;
- +1 ; loop all the bills for a patients account and keep looping them
- +2 ; until either there is no more bills or the money paid is zero.
- +3 ; the bills are looped in case of repayments. if there is money
- +4 ; left over, this will apply more money to the repayment bills
- +5 ; instead of creating a prepayment. a prepayment should only be
- +6 ; created if all bills for the account is collected/closed.
- +7 SET RCERROR=0
- +8 ; quit the loop if no money left to apply OR an error occurred OR
- +9 ; no more bills left to apply payment to
- +10 FOR
- Begin DoDot:1
- +11 ; loop the bills by date prepared and apply the payment
- +12 ; quit if no money left to apply OR and error occurred
- +13 SET RCDATE=""
- FOR
- SET RCDATE=$ORDER(^TMP("RCBEPAY",$JOB,RCDATE))
- if RCDATE=""
- QUIT
- Begin DoDot:2
- +14 SET RCBILLDA=0
- FOR
- SET RCBILLDA=$ORDER(^TMP("RCBEPAY",$JOB,RCDATE,RCBILLDA))
- if 'RCBILLDA
- QUIT
- Begin DoDot:3
- +15 LOCK +^PRCA(430,RCBILLDA):10
- +16 IF '$TEST
- SET RCERROR="1^Another user is working with bill "_$PIECE(^PRCA(430,RCBILLDA,0),"^")
- QUIT
- +17 ;
- +18 ; exempt any interest/admin/penalty charges added on or after
- +19 ; the payment date
- +20 DO EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
- +21 ;
- +22 ; get the repayment amount (if any)
- +23 ;PRCA*4.5*301
- SET RCREPAMT=$PIECE($GET(^PRCA(430,RCBILLDA,4)),"^",3)
- IF CSDEP=168!(CSDEP=170)
- SET RCREPAMT=0
- +24 ;
- +25 ; get the balance of the bill
- +26 SET X=$GET(^PRCA(430,RCBILLDA,7))
- +27 SET RCBILBAL=$PIECE(X,"^")+$PIECE(X,"^",2)+$PIECE(X,"^",3)+$PIECE(X,"^",4)+$PIECE(X,"^",5)
- +28 ; if bill has no balance, chg status = collected/closed
- +29 ;PRCA*4.5*301
- IF 'RCBILBAL
- Begin DoDot:4
- +30 DO CHGSTAT^RCBEUBIL(RCBILLDA,22)
- +31 LOCK -^PRCA(430,RCBILLDA)
- +32 KILL ^TMP("RCBEPAY",$JOB,RCDATE,RCBILLDA)
- End DoDot:4
- QUIT
- +33 ;
- +34 ; determine amount to pay
- +35 ; if the payment is greater than billed amount, pay billed amount
- +36 ; if there is a repayment amount, pay the repayment amount
- +37 ; do not allow payment to exceed amount paid
- +38 SET PAYMENT=RCPAYAMT
- +39 IF PAYMENT>RCBILBAL
- SET PAYMENT=RCBILBAL
- +40 IF RCREPAMT
- SET PAYMENT=RCREPAMT
- IF PAYMENT>RCBILBAL
- SET PAYMENT=RCBILBAL
- +41 IF PAYMENT>RCPAYAMT
- SET PAYMENT=RCPAYAMT
- +42 ;
- +43 ; apply payment to bill
- +44 ; return error if problem adding payment transaction
- +45 SET RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,PAYMENT,RCRECTDA,RCPAYDA,RCPAYDAT)
- +46 IF 'RCTRANDA
- LOCK -^PRCA(430,RCBILLDA)
- SET RCERROR="1^"_$PIECE(RCTRANDA,"^",2)
- QUIT
- +47 ;
- +48 ; payment applied to bill, subtract off the payment amount
- +49 SET RCPAYAMT=RCPAYAMT-$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5)
- +50 ;
- +51 ; set the amount processed on the receipt payment
- +52 DO SETAMT^RCBEPAY(RCRECTDA,RCPAYDA,$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5))
- +53 ;
- +54 ; if Bill is Cross-Serviced, then create DECREASED ADJUSTMENT for 5B reporting
- +55 ; BB prca*4.5*301
- IF $EXTRACT($GET(CSDEP),1,3)=168
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- DO CS5B(RCBILLDA)
- +56 ; BB prca*4.5*301
- IF $EXTRACT($GET(CSDEP),1,3)=170
- IF RCBILLDA'=CSBILLDA
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- DO CS5B(RCBILLDA)
- +57 ;
- +58 ; get the new balance of the bill. if it is zero
- +59 ; remove it from the tmp global (this will stop the
- +60 ; loop if dollars are left and no bills are active)
- +61 SET X=$GET(^PRCA(430,RCBILLDA,7))
- +62 SET RCBILBAL=$PIECE(X,"^")+$PIECE(X,"^",2)+$PIECE(X,"^",3)+$PIECE(X,"^",4)+$PIECE(X,"^",5)
- +63 ;PRCA*4.5*301
- IF 'RCBILBAL
- Begin DoDot:4
- +64 DO CHGSTAT^RCBEUBIL(RCBILLDA,22)
- +65 KILL ^TMP("RCBEPAY",$JOB,RCDATE,RCBILLDA)
- +66 ;S DA=RCBILLDA,DIE="^PRCA(430,",DR="151////@" D ^DIE K DIE,DA,DR
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- IF RCBILLDA=CSBILLDA
- SET $PIECE(^PRCA(430,RCBILLDA,15),"^")=""
- KILL ^PRCA(430,"TCSP",RCBILLDA)
- End DoDot:4
- +67 ;
- +68 LOCK -^PRCA(430,RCBILLDA)
- End DoDot:3
- IF 'RCPAYAMT!(RCERROR)
- QUIT
- End DoDot:2
- IF 'RCPAYAMT!(RCERROR)
- QUIT
- End DoDot:1
- IF 'RCPAYAMT!(RCERROR)!($ORDER(^TMP("RCBEPAY",$JOB,""))="")
- QUIT
- +69 ;
- +70 KILL ^TMP("RCBEPAY",$JOB)
- +71 ;
- +72 ; if an error occurred, quit
- +73 IF RCERROR
- LOCK -^RCD(340,RCDEBTDA)
- QUIT RCERROR
- +74 ;
- +75 ; if no money left, quit
- +76 IF 'RCPAYAMT
- LOCK -^RCD(340,RCDEBTDA)
- QUIT 0
- +77 ;
- +78 ; dollars remaining, create a prepayment
- +79 NEW %,%H,%I,%X,D,D0,DFN,DI,DIC,DICR,DIG,DIH,DIU,DIV,DIW,DQ,I,PRCA,RCREF,VA,VADM
- +80 DO EN^PRCAPAY3(RCACCT,RCPAYAMT,RCPAYDAT,DUZ,$PIECE(^RCY(344,RCRECTDA,0),"^"),"","",.RCERROR,"")
- +81 ; no errors
- +82 IF RCERROR=""!(RCERROR=0)
- Begin DoDot:1
- +83 SET RCERROR=0
- +84 ; set the amount processed on the receipt
- +85 DO SETAMT^RCBEPAY(RCRECTDA,RCPAYDA,RCPAYAMT)
- End DoDot:1
- +86 ; error creating prepayment
- +87 IF RCERROR'=0
- SET RCERROR="1^"_RCERROR
- +88 ;
- +89 LOCK -^RCD(340,RCDEBTDA)
- +90 QUIT RCERROR
- +91 ;
- CS5B(RCBILLDA) ; logs ADJ for 5B CS reporting if Cross-Serviced bill ; prca*4.5*301 ; LEG
- +1 ; Changed description from DEC ADJ to ADJ since increase adjustments will also use this code 315/DRF
- +2 ; note: can use either I +$G(^PRCA(430,RCBILLDA,15)) D ; bill is Cross-Serviced
- +3 ; bill is Cross-Serviced
- IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
- Begin DoDot:1
- +4 ; checks for valid bill
- +5 SET DIC="^PRCA(430,"
- SET DIC(0)="KMNZ"
- SET X=RCBILLDA
- DO ^DIC
- +6 ; checks if DEC ADJ record was previously logged
- +7 SET IDX=0
- SET PREV=0
- +8 ;
- FOR
- SET IDX=$ORDER(^PRCA(430,RCBILLDA,17,IDX))
- if 'IDX
- QUIT
- Begin DoDot:2
- +9 IF +$GET(^PRCA(430,RCBILLDA,17,IDX,0))=RCTRANDA
- SET PREV=1
- End DoDot:2
- +10 ; transaction was already logged
- IF PREV
- QUIT
- +11 ;
- +12 ; gets next ADJ subfile entry number or creates 1st
- +13 KILL DR,DA,DD,DO,DIC,DIE
- +14 ; CS ADJ TRANS NUMBER
- SET X=RCTRANDA
- +15 SET DA(1)=RCBILLDA
- +16 SET DIC="^PRCA(430,"_DA(1)_",17,"
- +17 SET DIC(0)="KLMNZ"
- +18 SET DIC("P")=$PIECE(^DD(430,171,0),"^",2)
- +19 DO ^DIC
- +20 ; set ADJ Fields
- +21 SET DIE=DIC
- KILL DIC
- +22 SET DA=+Y
- +23 ; SEND TCSP RECORD 5B
- SET DR="1////1"
- +24 SET DIC("DR")=DR
- +25 DO ^DIE
- End DoDot:1
- +26 QUIT