- RCCPCBJ ;WASH-ISC@ALTOONA,PA/NYB-Background Driver for CCPC ;1/7/97 9:42 AM
- ;;4.5;Accounts Receivable;**34,76,130,153,166,195,217,237**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;Starts the background job for CCPC 5 days before statement day
- N X,X1,X2,X3,ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- D ACK
- S X1=$$STD^RCCPCFN,X2=-2 D C^%DTC
- ;10-process end time/18-ccpc file built
- I X=DT D Q
- . S X3=$O(^RCPS(349.2,0)) Q:'X3
- . Q:'$P($P($G(^RCPS(349.2,X3,0)),"^",10),".")
- . Q:'$P($G(^RCPS(349.2,X3,0)),"^",18)
- . D EN^RCCPCML
- ;quit if date created is yesterday's date
- S X1=$$STD^RCCPCFN,X2=-1 D C^%DTC
- I X=DT D Q
- . S X3=+$O(^RCT(349,0))
- . S X3=$P($P($G(^RCT(349,X3,0)),"^",11),".")
- . S X1=DT,X2=-1 D C^%DTC
- . I X=X3 Q
- . D EN^RCCPCML
- ;
- S X1=$$STD^RCCPCFN,X2=-3 D C^%DTC
- I X'=DT Q
- I DT'<$P($G(^RC(342,1,30)),"^",1)&(DT'>$P($G(^RC(342,1,30)),"^",2)) D ^RCEXINAD
- S ZTIO="",ZTRTN="OPEN^RCCPCBJ",ZTDESC="CCPC PATIENT STATEMENT"
- S ZTDTH=$H D ^%ZTLOAD
- Q
- OPEN ;Update Open status bills to Active or Cancellation status
- N DAY,BN,DEBTOR,DA,DIE,DR,P,AMT
- N ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
- S DATE=$$STD^RCCPCFN,DAY=+$$STDY^RCCPCFN,DEBTOR=0 F S DEBTOR=$O(^RCD(340,"AC",DAY,DEBTOR)) Q:'DEBTOR D
- .S BN=0 F S BN=$O(^PRCA(430,"AS",DEBTOR,$O(^PRCA(430.3,"AC",112,0)),BN)) Q:'BN D
- ..S AMT=0 F P=1:1:5 S AMT=$P($G(^PRCA(430,+BN,7)),"^",P)+AMT
- ..I $P($G(^PRCA(430,+BN,0)),"^",2)=$O(^PRCA(430.2,"AC",33,0)),AMT Q
- ..S DIE="^PRCA(430,",DA=+BN,DR="8////^S X="_$S(AMT:$O(^PRCA(430.3,"AC",102,0)),1:$O(^PRCA(430.3,"AC",111,0))) D ^DIE K DA,DIE,DR
- ..Q
- .Q
- ;
- ; update patient accounts with interest and admin
- N RCLASDAT
- S RCLASDAT=DATE
- I DT>3010101 D FIRSTPTY^RCBECHGS
- D ^RCCPCPS
- D REFUND
- Q
- ;
- ;
- REFUND ;Update Open status PREPAYMENT bills to REFUND REVIEW
- S DEBTOR=0,DAY=+$$STDY^RCCPCFN
- F S DEBTOR=$O(^RCD(340,"AC",DAY,DEBTOR)) Q:'DEBTOR D
- .S BN=0 F S BN=$O(^PRCA(430,"AS",DEBTOR,$O(^PRCA(430.3,"AC",112,0)),BN)) Q:'BN D
- ..I $P($G(^PRCA(430,+BN,0)),"^",2)=$O(^PRCA(430.2,"AC",33,0)) S X=$$EN^PRCARFU(+BN)
- ..Q
- .Q
- Q
- ;
- ACK ;CHECK FOR ACKNOWLEDGEMENTS
- N DEB,MSG,NO,RCX,X,X1,X2
- S X1=$$STD^RCCPCFN,X2=DT D ^%DTC I X>3 D
- .D TRANCHK^RCCPCSV1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCCPCBJ 2310 printed Feb 18, 2025@23:09:32 Page 2
- RCCPCBJ ;WASH-ISC@ALTOONA,PA/NYB-Background Driver for CCPC ;1/7/97 9:42 AM
- +1 ;;4.5;Accounts Receivable;**34,76,130,153,166,195,217,237**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;Starts the background job for CCPC 5 days before statement day
- +1 NEW X,X1,X2,X3,ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
- +2 DO ACK
- +3 SET X1=$$STD^RCCPCFN
- SET X2=-2
- DO C^%DTC
- +4 ;10-process end time/18-ccpc file built
- +5 IF X=DT
- Begin DoDot:1
- +6 SET X3=$ORDER(^RCPS(349.2,0))
- if 'X3
- QUIT
- +7 if '$PIECE($PIECE($GET(^RCPS(349.2,X3,0)),"^",10),".")
- QUIT
- +8 if '$PIECE($GET(^RCPS(349.2,X3,0)),"^",18)
- QUIT
- +9 DO EN^RCCPCML
- End DoDot:1
- QUIT
- +10 ;quit if date created is yesterday's date
- +11 SET X1=$$STD^RCCPCFN
- SET X2=-1
- DO C^%DTC
- +12 IF X=DT
- Begin DoDot:1
- +13 SET X3=+$ORDER(^RCT(349,0))
- +14 SET X3=$PIECE($PIECE($GET(^RCT(349,X3,0)),"^",11),".")
- +15 SET X1=DT
- SET X2=-1
- DO C^%DTC
- +16 IF X=X3
- QUIT
- +17 DO EN^RCCPCML
- End DoDot:1
- QUIT
- +18 ;
- +19 SET X1=$$STD^RCCPCFN
- SET X2=-3
- DO C^%DTC
- +20 IF X'=DT
- QUIT
- +21 IF DT'<$PIECE($GET(^RC(342,1,30)),"^",1)&(DT'>$PIECE($GET(^RC(342,1,30)),"^",2))
- DO ^RCEXINAD
- +22 SET ZTIO=""
- SET ZTRTN="OPEN^RCCPCBJ"
- SET ZTDESC="CCPC PATIENT STATEMENT"
- +23 SET ZTDTH=$HOROLOG
- DO ^%ZTLOAD
- +24 QUIT
- OPEN ;Update Open status bills to Active or Cancellation status
- +1 NEW DAY,BN,DEBTOR,DA,DIE,DR,P,AMT
- +2 NEW ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
- +3 SET DATE=$$STD^RCCPCFN
- SET DAY=+$$STDY^RCCPCFN
- SET DEBTOR=0
- FOR
- SET DEBTOR=$ORDER(^RCD(340,"AC",DAY,DEBTOR))
- if 'DEBTOR
- QUIT
- Begin DoDot:1
- +4 SET BN=0
- FOR
- SET BN=$ORDER(^PRCA(430,"AS",DEBTOR,$ORDER(^PRCA(430.3,"AC",112,0)),BN))
- if 'BN
- QUIT
- Begin DoDot:2
- +5 SET AMT=0
- FOR P=1:1:5
- SET AMT=$PIECE($GET(^PRCA(430,+BN,7)),"^",P)+AMT
- +6 IF $PIECE($GET(^PRCA(430,+BN,0)),"^",2)=$ORDER(^PRCA(430.2,"AC",33,0))
- IF AMT
- QUIT
- +7 SET DIE="^PRCA(430,"
- SET DA=+BN
- SET DR="8////^S X="_$SELECT(AMT:$ORDER(^PRCA(430.3,"AC",102,0)),1:$ORDER(^PRCA(430.3,"AC",111,0)))
- DO ^DIE
- KILL DA,DIE,DR
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 ;
- +11 ; update patient accounts with interest and admin
- +12 NEW RCLASDAT
- +13 SET RCLASDAT=DATE
- +14 IF DT>3010101
- DO FIRSTPTY^RCBECHGS
- +15 DO ^RCCPCPS
- +16 DO REFUND
- +17 QUIT
- +18 ;
- +19 ;
- REFUND ;Update Open status PREPAYMENT bills to REFUND REVIEW
- +1 SET DEBTOR=0
- SET DAY=+$$STDY^RCCPCFN
- +2 FOR
- SET DEBTOR=$ORDER(^RCD(340,"AC",DAY,DEBTOR))
- if 'DEBTOR
- QUIT
- Begin DoDot:1
- +3 SET BN=0
- FOR
- SET BN=$ORDER(^PRCA(430,"AS",DEBTOR,$ORDER(^PRCA(430.3,"AC",112,0)),BN))
- if 'BN
- QUIT
- Begin DoDot:2
- +4 IF $PIECE($GET(^PRCA(430,+BN,0)),"^",2)=$ORDER(^PRCA(430.2,"AC",33,0))
- SET X=$$EN^PRCARFU(+BN)
- +5 QUIT
- End DoDot:2
- +6 QUIT
- End DoDot:1
- +7 QUIT
- +8 ;
- ACK ;CHECK FOR ACKNOWLEDGEMENTS
- +1 NEW DEB,MSG,NO,RCX,X,X1,X2
- +2 SET X1=$$STD^RCCPCFN
- SET X2=DT
- DO ^%DTC
- IF X>3
- Begin DoDot:1
- +3 DO TRANCHK^RCCPCSV1
- End DoDot:1
- +4 QUIT