| 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
 | 
|---|