| 1 | RCCPCSTM ;WASH-ISC@ALTOONA,PA/LDB-Patient Statement ;2/14/97  5:12 PM
 | 
|---|
| 2 | V ;;4.5;Accounts Receivable;**70**;Mar 20, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;ENTRY FROM NIGHTLY PROCESS
 | 
|---|
| 5 |  NEW HDAT,DEB
 | 
|---|
| 6 | STM ;called by RCCPCPS to print >32K at site
 | 
|---|
| 7 |  NEW DAT,END,LDT1,LDT3,SDT,SITE,PRNT,X1,X2
 | 
|---|
| 8 |  D DT^DICRW,SITE^PRCAGU
 | 
|---|
| 9 |  S:$G(HDAT)="" HDAT=DT S SDT=+$E(HDAT,6,7),DAT=HDAT
 | 
|---|
| 10 |  D NOW^%DTC S END=%
 | 
|---|
| 11 |  S LDT1=$$FPS^RCAMFN01(HDAT,-1)
 | 
|---|
| 12 |  S LDT3=$$FPS^RCAMFN01(HDAT,-3)
 | 
|---|
| 13 |  S DEB=0 F  S DEB=$O(^XTMP("RCCPC",DEB)) Q:'DEB  D STS
 | 
|---|
| 14 |  K ^XTMP("RCCPC")
 | 
|---|
| 15 |  Q
 | 
|---|
| 16 | STS ;start statement process
 | 
|---|
| 17 |  NEW BBAL,BEG,PBAL,PDAT,PEND,SBAL,SDT,TBAL,X,Y
 | 
|---|
| 18 |  K ^TMP("PRCAGT",$J)
 | 
|---|
| 19 |  D NOW^%DTC S END=%
 | 
|---|
| 20 |  S BEG=+$$LST^RCFN01(DEB,2) I $P(BEG,".")'<$P(DAT,".") G STSQ ;statement printed on or after this date
 | 
|---|
| 21 |  I BEG<1 S PDAT="",BEG=0,PBAL=0 ;get last date/time event occurred
 | 
|---|
| 22 |  I BEG S PDAT=BEG,BEG=9999999.999999-BEG,PBAL=0 D PBAL^PRCAGU(DEB,.BEG,.PBAL) ;Get previous bal and prev date of last transaction
 | 
|---|
| 23 |  D EN^PRCAGT(DEB,BEG,.END) ;get transactions reset END to last tran
 | 
|---|
| 24 |  S TBAL=0 D TBAL^PRCAGT(DEB,.TBAL) ;get trans bal
 | 
|---|
| 25 |  S BBAL=0 D BBAL^PRCAGU(DEB,.BBAL) ;get bill bal
 | 
|---|
| 26 |  S X=$$PRE^PRCAGU(DEB) S PEND=$P(X,U,2),X=+X I X,BBAL D REF^PRCAGD(DEB,X,$G(REP)) G STSQ ;unprocessed refund and outstand bills send disc
 | 
|---|
| 27 |  I BBAL=0,PEND,-PEND=PBAL+TBAL G STSQ ;all of the amount due is prepayment pending or refund review status
 | 
|---|
| 28 |  I BBAL'=(PBAL+TBAL) D EN^PRCAGD(DEB,BBAL,TBAL,PBAL,BEG,$G(REP)) G STSQ ;send disc
 | 
|---|
| 29 |  I BBAL=0,$G(SITE("ZERO")) G STSQ ;zero balance
 | 
|---|
| 30 |  I BBAL'>0,'$D(^TMP("PRCAGT",$J,DEB)) G STSQ ;no amt due no activity
 | 
|---|
| 31 |  I BBAL<0,BBAL>-.99 G STSQ ;refund less than 1.00
 | 
|---|
| 32 |  I BBAL'<0,'$$ACT^PRCAGT(DEB,LDT3) G STSQ ;no activty past 3 stat
 | 
|---|
| 33 |  S TBAL=TBAL+PBAL
 | 
|---|
| 34 |  D EN^PRCAGST(DEB,.TBAL,PDAT,PBAL) S SITE("SCAN")="" ;print statement
 | 
|---|
| 35 |  D EN^PRCAGF(DEB,TBAL) S ERR="" ;get forms and print
 | 
|---|
| 36 |  D OPEN^RCEVDRV1(2,$P(^RCD(340,DEB,0),U),END,DUZ,$$SITE^RCMSITE,.ERR,.EVN,BBAL("PB")_U_BBAL("INT")_U_BBAL("ADM")_U_BBAL("CT")_U_BBAL("MF"))
 | 
|---|
| 37 |  I EVN D CLOSE^RCEVDRV1(EVN)
 | 
|---|
| 38 |  D UPDAT^PRCAGU(DEB,DT) ;set bill letter field
 | 
|---|
| 39 |  S SITE("SCAN")=$G(^RC(342,1,5))
 | 
|---|
| 40 | STSQ Q
 | 
|---|