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 Apr 09, 2024@20:50:06 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
