[613] | 1 | RCCPCBJ ;WASH-ISC@ALTOONA,PA/NYB-Background Driver for CCPC ;1/7/97 9:42 AM
|
---|
| 2 | ;;4.5;Accounts Receivable;**34,76,130,153,166,195,217,237**;Mar 20, 1995
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | EN ;Starts the background job for CCPC 5 days before statement day
|
---|
| 5 | N X,X1,X2,X3,ZTRTN,ZTIO,ZTDTH,ZTSK,ZTDESC
|
---|
| 6 | D ACK
|
---|
| 7 | S X1=$$STD^RCCPCFN,X2=-2 D C^%DTC
|
---|
| 8 | ;10-process end time/18-ccpc file built
|
---|
| 9 | I X=DT D Q
|
---|
| 10 | . S X3=$O(^RCPS(349.2,0)) Q:'X3
|
---|
| 11 | . Q:'$P($P($G(^RCPS(349.2,X3,0)),"^",10),".")
|
---|
| 12 | . Q:'$P($G(^RCPS(349.2,X3,0)),"^",18)
|
---|
| 13 | . D EN^RCCPCML
|
---|
| 14 | ;quit if date created is yesterday's date
|
---|
| 15 | S X1=$$STD^RCCPCFN,X2=-1 D C^%DTC
|
---|
| 16 | I X=DT D Q
|
---|
| 17 | . S X3=+$O(^RCT(349,0))
|
---|
| 18 | . S X3=$P($P($G(^RCT(349,X3,0)),"^",11),".")
|
---|
| 19 | . S X1=DT,X2=-1 D C^%DTC
|
---|
| 20 | . I X=X3 Q
|
---|
| 21 | . D EN^RCCPCML
|
---|
| 22 | ;
|
---|
| 23 | S X1=$$STD^RCCPCFN,X2=-3 D C^%DTC
|
---|
| 24 | I X'=DT Q
|
---|
| 25 | I DT'<$P($G(^RC(342,1,30)),"^",1)&(DT'>$P($G(^RC(342,1,30)),"^",2)) D ^RCEXINAD
|
---|
| 26 | S ZTIO="",ZTRTN="OPEN^RCCPCBJ",ZTDESC="CCPC PATIENT STATEMENT"
|
---|
| 27 | S ZTDTH=$H D ^%ZTLOAD
|
---|
| 28 | Q
|
---|
| 29 | OPEN ;Update Open status bills to Active or Cancellation status
|
---|
| 30 | N DAY,BN,DEBTOR,DA,DIE,DR,P,AMT
|
---|
| 31 | N ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH
|
---|
| 32 | S DATE=$$STD^RCCPCFN,DAY=+$$STDY^RCCPCFN,DEBTOR=0 F S DEBTOR=$O(^RCD(340,"AC",DAY,DEBTOR)) Q:'DEBTOR D
|
---|
| 33 | .S BN=0 F S BN=$O(^PRCA(430,"AS",DEBTOR,$O(^PRCA(430.3,"AC",112,0)),BN)) Q:'BN D
|
---|
| 34 | ..S AMT=0 F P=1:1:5 S AMT=$P($G(^PRCA(430,+BN,7)),"^",P)+AMT
|
---|
| 35 | ..I $P($G(^PRCA(430,+BN,0)),"^",2)=$O(^PRCA(430.2,"AC",33,0)),AMT Q
|
---|
| 36 | ..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
|
---|
| 37 | ..Q
|
---|
| 38 | .Q
|
---|
| 39 | ;
|
---|
| 40 | ; update patient accounts with interest and admin
|
---|
| 41 | N RCLASDAT
|
---|
| 42 | S RCLASDAT=DATE
|
---|
| 43 | I DT>3010101 D FIRSTPTY^RCBECHGS
|
---|
| 44 | D ^RCCPCPS
|
---|
| 45 | D REFUND
|
---|
| 46 | Q
|
---|
| 47 | ;
|
---|
| 48 | ;
|
---|
| 49 | REFUND ;Update Open status PREPAYMENT bills to REFUND REVIEW
|
---|
| 50 | S DEBTOR=0,DAY=+$$STDY^RCCPCFN
|
---|
| 51 | F S DEBTOR=$O(^RCD(340,"AC",DAY,DEBTOR)) Q:'DEBTOR D
|
---|
| 52 | .S BN=0 F S BN=$O(^PRCA(430,"AS",DEBTOR,$O(^PRCA(430.3,"AC",112,0)),BN)) Q:'BN D
|
---|
| 53 | ..I $P($G(^PRCA(430,+BN,0)),"^",2)=$O(^PRCA(430.2,"AC",33,0)) S X=$$EN^PRCARFU(+BN)
|
---|
| 54 | ..Q
|
---|
| 55 | .Q
|
---|
| 56 | Q
|
---|
| 57 | ;
|
---|
| 58 | ACK ;CHECK FOR ACKNOWLEDGEMENTS
|
---|
| 59 | N DEB,MSG,NO,RCX,X,X1,X2
|
---|
| 60 | S X1=$$STD^RCCPCFN,X2=DT D ^%DTC I X>3 D
|
---|
| 61 | .D TRANCHK^RCCPCSV1
|
---|
| 62 | Q
|
---|