Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCCPCPS

RCCPCPS.m

Go to the documentation of this file.
  1. RCCPCPS ;WASH-ISC@ALTOONA,PA/NYB - Build Patient Statement File ;12/19/96 4:14 PM
  1. V ;;4.5;Accounts Receivable;**34,70,80,48,104,116,149,170,181,190,223,237,219,265,301,348,397,401**;Mar 20,1995;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRCA*4.5*348 Set 'BEG' lookup to handle last statement event
  1. ; whether exists or not
  1. ;
  1. EN N CCPC,CNT,DAT,DEB,DIK,END,INADFL,LDT1,LDT3,PCC,PRN,RCDATE,RCT,SVADM,SVAMT,SVINT,SVOTH,SITE,TXT,VAR,X,%
  1. N RCINFULL,RCINPART,STATLIM S COMM=0
  1. S STATLIM=$$GET1^DIQ(342,1_",",101,"I")+1 ;Statment Length from AR Site Parameter file
  1. K ^RCPS(349.2)
  1. F X="PA","IS" S RCT=$O(^RCT(349.1,"B",X,0)) Q:'RCT K ^RCT(349.1,+RCT,4),^RCT(349.1,+RCT,5)
  1. K ^XTMP("RCCPC")
  1. D DT^DICRW,SITE^PRCAGU
  1. I '$D(SITE) W !!,"AR SITE PARAMETER ENTRIES NOT DEFINED!",?50 D NOW^%DTC S Y=% D DD^%DT W Y W !!,"COULD NOT PROCESS AR PATIENT STATEMENTS" Q
  1. D NOW^%DTC S END=%
  1. S LDT1=$$FPS^RCAMFN01(DT,-1),RCDATE=DT
  1. S (CNT,DEB)=0,PRN=1
  1. F S DEB=$O(^RCD(340,"AB","DPT(",DEB)) Q:DEB="" D
  1. . N AMT,BBAL,BEG,BN,CAT,DESC,ETY,FC,ND,PAT,PBAL,PC
  1. . N PDAT,PEND,ST,SVINT,SVADM,SVOTH,ADDR
  1. . I $L(+$$SSN^RCFN01(DEB))<5 Q
  1. . ;Check for Emergency Response Indicator (ERI) Flag.
  1. . N RCDFN S RCDFN=$P($G(^RCD(340,DEB,0)),"^",1) I $$EMERES^PRCAUTL(+RCDFN)]"" Q
  1. . ; initialize variables for CS
  1. . N CSBB,CSTCH,CSTPC,CSPREV S (CSBB,CSTCH,CSTPC)=0
  1. . S INADFL=0
  1. . S (SVADM,SVAMT,SVINT,SVOTH)=0
  1. . N REF,SBAL,SDT,TBAL,TN,TTY,X,Y
  1. . K ^TMP("PRCAGT",$J)
  1. . S BEG=+$$LST^RCFN01(DEB,2,1)
  1. . S LDT3=$S(BEG>0:$$FPS^RCAMFN01($P(BEG,"."),-3),1:0)
  1. . I $P(BEG,".")'<$P(RCDATE,".") Q
  1. . D NOW^%DTC S END=%
  1. . I BEG<1 S PDAT="",BEG=0,PBAL=0
  1. . I BEG S PDAT=BEG,BEG=9999999.999999-BEG,PBAL=0 D PBAL^PRCAGU(DEB,.BEG,.PBAL,1) ;get prev bal ; PRCA*4.5*348 set statement flag
  1. . D EN^PRCAGT(DEB,BEG,.END)
  1. . S TBAL=0 D TBAL^PRCAGT(DEB,.TBAL) ;get trans bal
  1. . S BBAL=0 D BBAL^PRCAGU(DEB,.BBAL) ;get bill bal
  1. . I CSBB,CSBB'<BBAL Q ; entire account has been referred to CS
  1. . S X=$$PRE^PRCAGU(DEB) S PEND=$P(X,U,2),X=+X I X,BBAL D REF^PRCAGD(DEB,X,$G(REP)) Q
  1. . I BBAL=0,PEND,-PEND=PBAL+TBAL Q
  1. . I BBAL'=(PBAL+TBAL) D EN^PRCAGD(DEB,BBAL,TBAL,PBAL,BEG,$G(REP)) Q
  1. . I BBAL'>0,'$D(^TMP("PRCAGT",$J,DEB)) Q
  1. . I BBAL=0,$G(SITE("ZERO")) Q
  1. . I BBAL<0,BBAL>-.99 Q
  1. . I BBAL'<0,'$D(^XTMP("PRCAGU",$J,DEB)),'COMM Q ;third letter printed,not comment
  1. . S TBAL=TBAL+PBAL
  1. . ;adjust amounts to be filed in 349.2 for CS bills
  1. . S TBAL=TBAL-CSBB ; reduce the total bill balance by CS balance
  1. . S CSPREV=CSBB-(CSTCH+CSTPC) ; compute the CS previous balance as the difference between the bill balance and the transaction balance
  1. . S PBAL=PBAL-CSPREV ; reduce the previous balance by the CS previous balance
  1. . S TBAL("CH")=TBAL("CH")-CSTCH ; reduce total charges by CS charges
  1. . S TBAL("PC")=TBAL("PC")-CSTPC ; reduce total credits by CS credits
  1. . I '$D(^RCPS(349.2,0)) S ^(0)="AR CCPC STATEMENTS RECORDS^349.2I^"
  1. . S ^RCPS(349.2,DEB,0)=DEB_"^"_$$SSN^RCFN01(DEB)_"^"
  1. . S ADDR=$$DADD^RCAMADD(DEB,1) ;get patient's address, confidential if applicable
  1. . S ^RCPS(349.2,DEB,1)=$P(ADDR,"^",1,6)
  1. . S ST=$P(ADDR,"^",5)
  1. . S ^RCPS(349.2,DEB,7)=$P(^RCD(340,DEB,0),U,7) ;large print
  1. . I $G(ST)'="" S ST=$O(^DIC(5,"C",ST,0))
  1. . I $G(ST)>90,'$P($G(^DIC(5,ST,0)),"^",6) S FC=$P($G(^DIC(5,ST,0)),"^")
  1. . S $P(^RCPS(349.2,DEB,1),"^",7)=$G(FC) S:$G(FC)]"" $P(^RCPS(349.2,DEB,1),"^",5)="FX"
  1. . S:$G(FC)]"" $P(^RCPS(349.2,DEB,1),"^",6)=$P(ADDR,"^",8)
  1. . D NOW^%DTC S $P(^RCPS(349.2,DEB,0),"^",10)=%
  1. . S $P(^RCPS(349.2,DEB,0),"^",3)=$$NAM^RCFN01(DEB)
  1. . S $P(^RCPS(349.2,DEB,0),"^",4,7)=$S(TBAL'>0:0,1:TBAL)_"^"_PBAL_"^"_TBAL("CH")_"^"_TBAL("PC"),$P(^(0),"^",8)=PBAL+TBAL("CH")+TBAL("PC")+TBAL("RF")
  1. . S $P(^RCPS(349.2,DEB,0),"^",13,17)=BBAL("PB")_"^"_BBAL("INT")_"^"_BBAL("ADM")_"^"_BBAL("MF")_"^"_BBAL("CT")
  1. . ;
  1. . N RCBILLDA,RCDATA1,RCDEBTDA,RCDESC,RCPSDA,RCTOTAL,RCTRANDA,RCTRDATE,VALUE,RCCOM1,RCCOM2,RCCOM3
  1. . S RCDEBTDA=DEB
  1. . I '$D(^RCPS(349.2,RCDEBTDA,2,0)) S ^(0)="^349.21DA^^"
  1. . ;
  1. . S RCCOM1=$E($TR($G(SITE("COM1")),"~|^",""),1,80),(RCCOM2,RCCOM3)=""
  1. . ; Add second comment line for the GMT-reduced status
  1. . I $$GMT^PRCAGST(RCDEBTDA) S RCCOM2="REDUCTION OF INPATIENT COPAYMENT DUE TO GEOGRAPHIC MEANS TEST STATUS"
  1. . I TBAL'>0 S RCCOM3=" *THIS IS NOT A BILL*"
  1. . I RCCOM1'="",RCCOM2'="" S $E(RCCOM1,80)=" " ;Make sure GMT message will be printed on separate line.
  1. . S ^RCPS(349.2,RCDEBTDA,3)=RCCOM1_RCCOM2_RCCOM3
  1. . ;
  1. . S RCPSDA=0 ; this variable used to set the description on the PS segment
  1. . S RCTRDATE=0 F S RCTRDATE=$O(^TMP("PRCAGT",$J,RCDEBTDA,RCTRDATE)) Q:'RCTRDATE S RCBILLDA=0 F S RCBILLDA=$O(^TMP("PRCAGT",$J,RCDEBTDA,RCTRDATE,RCBILLDA)) Q:'RCBILLDA D
  1. . . Q:$D(^PRCA(430,"TCSP",RCBILLDA)) ; skip CS bills/transactions
  1. . . I $P($G(^RCPS(349.2,RCDEBTDA,0)),"^",8)<0 S PC(75)=75
  1. . . I $P($G(^PRCA(430,RCBILLDA,6)),"^",2)]"",($P($G(^PRCA(430,RCBILLDA,7)),"^")>0) S PC(1)="01"
  1. . . S CAT=$P($G(^PRCA(430,RCBILLDA,0)),"^",2)
  1. . . S PC=$P($G(^PRCA(430.2,CAT,0)),"^",14)
  1. . . F X=1:1:100 I $P(PC,",",X)'="" S PCC=$P(PC,",",X),PC(+PCC)=PCC Q:PCC=""
  1. . . S PC="",X=0 F S X=$O(PC(X)) Q:X="" I $G(PC(X))'="" S PC=PC_PC(X)
  1. . . S $P(^RCPS(349.2,RCDEBTDA,4),"^")=PC
  1. . . ;
  1. . . I $D(^TMP("PRCAGT",$J,RCDEBTDA,RCTRDATE,RCBILLDA,0)) S AMT=+^(0) I AMT D
  1. . . . ; get the description for the bill
  1. . . . K RCDESC D BILLDESC^RCCPCPS1(RCBILLDA)
  1. . . . ;
  1. . . . ; store the description in file 349.2, PS segment
  1. . . . S RCPSDA=RCPSDA+1
  1. . . . S $P(^RCPS(349.2,RCDEBTDA,2,RCPSDA,0),"^",1,4)=$P(RCTRDATE,".")_"^"_$G(RCDESC(1))_"^"_$G(AMT)_"^"_$P(^PRCA(430,RCBILLDA,0),"^")
  1. . . . F X=2:1 Q:$G(RCDESC(X))="" S RCPSDA=RCPSDA+1,^RCPS(349.2,RCDEBTDA,2,RCPSDA,0)="^"_RCDESC(X)_"^^"
  1. . . ;
  1. . . S RCTRANDA=0 F S RCTRANDA=$O(^TMP("PRCAGT",$J,RCDEBTDA,RCTRDATE,RCBILLDA,RCTRANDA)) D:'RCTRANDA NO Q:'RCTRANDA D
  1. . . . ; get the description for the transaction
  1. . . . K RCDESC D TRANDESC^RCCPCPS1(RCTRANDA),RCDESC
  1. . . . ; if it is an interest/admin charge, summarize it below
  1. . . . I $G(RCDESC(1))["INTEREST" Q
  1. . . . ; get the value of the transaction for the statement
  1. . . . S VALUE=$$TRANVALU^RCDPBTLM(RCTRANDA)
  1. . . . S VALUE=$P(VALUE,"^",2)+$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5)+$P(VALUE,"^",6)
  1. . . . ; if it is a suspended (47) or unsuspended (46) transaction, show value
  1. . . . ; make suspended charges appear as negative
  1. . . . S RCDATA1=$G(^PRCA(433,RCTRANDA,1))
  1. . . . I $P(RCDATA1,"^",2)=47!($P(RCDATA1,"^",2)=46) S VALUE=$P(RCDATA1,"^",5) I $P(RCDATA1,"^",2)=47 S VALUE=-VALUE
  1. . . . ; if it is an amended bill, show value
  1. . . . I $P(RCDATA1,"^",2)=33 S VALUE=$P(RCDATA1,"^",5)
  1. . . . ; store the description in file 349.2, PS segment
  1. . . . S RCPSDA=RCPSDA+1
  1. . . . S $P(^RCPS(349.2,RCDEBTDA,2,RCPSDA,0),"^",1,5)=$P(RCTRDATE,".")_"^"_$G(RCDESC(1))_"^"_VALUE_"^"_$P(^PRCA(430,RCBILLDA,0),"^")
  1. . . . F X=2:1 Q:$G(RCDESC(X))="" S RCPSDA=RCPSDA+1,^RCPS(349.2,RCDEBTDA,2,RCPSDA,0)="^"_RCDESC(X)_"^^"
  1. . . . ;
  1. . . . ; for comment transaction ... not sure what this is for ?
  1. . . . I $P(RCDATA1,"^",2)=45,$P($G(^PRCA(433,RCTRANDA,5)),"^",2)["your waiver rights" S ^RCPS(349.2,+RCDEBTDA,4)="0150"
  1. . ;
  1. . ; if interest, admin, or other, add them here
  1. . S X=$G(RCTOTAL("INT"))+$G(RCTOTAL("ADM"))+$G(RCTOTAL("OTH"))
  1. . I X>0 D
  1. . . S RCDESC="INTEREST/ADM. CHARGE (Int:"_$J($G(RCTOTAL("INT")),1,2)_" Adm:"_$J($G(RCTOTAL("ADM")),1,2)_" Other:"_$J($G(RCTOTAL("OTH")),1,2)_")"
  1. . . S RCPSDA=RCPSDA+1
  1. . . S ^RCPS(349.2,RCDEBTDA,2,RCPSDA,0)="^"_RCDESC_"^"_$J(X,1,2)
  1. . . S ^RCPS(349.2,RCDEBTDA,2,0)="^349.21DA^"_RCPSDA_"^"_RCPSDA
  1. . ;
  1. . ; set 0th node
  1. . I RCPSDA S ^RCPS(349.2,RCDEBTDA,2,0)="^349.21DA^"_RCPSDA_"^"_RCPSDA
  1. . ;
  1. . I RCPSDA'<STATLIM D Q ;PRCA*4.5*401 Flag Oversized statements for later printing
  1. . . D FILEOSFG(RCDEBTDA,"S")
  1. . . S DIK="^RCPS(349.2,",DA=RCDEBTDA D ^DIK ;Remove statement from file 349.2 if oveersize
  1. . D NO
  1. ;
  1. S DIK="^RCPS(349.2," D IXALL^DIK
  1. S DEB=0 S DEB=$O(^RCPS(349.2,DEB)) Q:DEB="" S $P(^(DEB,0),"^",18)=1
  1. K ^XTMP("PRCAGU",$J,DEB),COMM
  1. D RCCPOSST ;Check for Over Size statements and send exteranl email to
  1. Q
  1. ;
  1. OSTM ;Process old statements ;PRCA*4.5*401
  1. ;S DIK="^RCPS(349.2,",DA=0 F S DA=$O(^XTMP("RCCPC",DA)) Q:'DA D ^DIK
  1. ;K DA
  1. ;
  1. STATMNT ;Print oversized patient statements to local printer
  1. N POP,ZTIO,ZTSAVE,ZTRTN,ZTDESC,ZTASK,%ZIS,ZTDTH,PRCADEV,DIR
  1. N DIRUT,DTOUT,DUOUT,DIROUT,X,Y
  1. ;
  1. ;Confirm to continue
  1. S DIR("A",1)="You are about to print oversized patient statements locally. "
  1. S DIR("A")="Are you sure you wish to print these statements? (Y/N)"
  1. S DIR(0)="Y",DIR("B")="Y"
  1. D ^DIR
  1. ;
  1. I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W !,"Nothing done" Q
  1. I Y'=1 W !,"Nothing done" Q
  1. ;
  1. W !
  1. S DIR("A")="Print to the (S)creen or to the (D)efault Printer? <Default> (S/D)"
  1. S DIR(0)="SB^S:Screen;D:Default",DIR("B")="D"
  1. D ^DIR
  1. ;
  1. I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W !,"Nothing done" Q
  1. ;
  1. I Y="D" S (IOP,PRCADEV)=$P($G(^RC(342,1,"CCPC")),"^",2) ; set printer to file #342 field 102
  1. I Y="D",(IOP']"") W !,"Cannot continue." Q
  1. I Y="S" K IOP,IO("Q") S %ZIS="MQ" D ^%ZIS Q:POP
  1. I Y="D" S %ZIS="N0" D ^%ZIS Q:POP
  1. I Y="S" D STM^RCCPCSTM Q
  1. S ZTRTN="STM^RCCPCSTM",ZTDTH=$H,ZTDESC="Print old AR Statements"
  1. S ZTSAVE("PRCADEV")=""
  1. D ^%ZTLOAD,^%ZISC
  1. Q
  1. ;
  1. NO ;If there is no activity
  1. I $G(^RCPS(349.2,+DEB,4))["0150" D
  1. .S ^RCPS(349.2,+DEB,2,1,0)="^NOTICE: You now have delinquent charges. Please^^"
  1. .S ^RCPS(349.2,+DEB,2,2,0)="^review Enforcement of Involuntary Collections^^"
  1. .S ^RCPS(349.2,+DEB,2,3,0)="^on reverse.^^"
  1. .S ^RCPS(349.2,+DEB,2,0)="^^3^3"
  1. I $G(^RCPS(349.2,DEB,2,1,0))="" D
  1. .S ^RCPS(349.2,DEB,2,1,0)="^No Activity in the Last 30 Days!^^"
  1. .S ^RCPS(349.2,DEB,2,2,0)="^Please refer to previous statement of rights.^^"
  1. .S ^RCPS(349.2,DEB,2,0)="^^2^2"
  1. .I $G(^RCPS(349.2,DEB,4))="" S ^(4)="90"
  1. Q
  1. BUILD ;This is the entry point from the BUILD CCPC file option
  1. N TDT,QDT,ZTDESC,ZTASK,ZTSK,ZDTDTH,ZTIO,ZTRTN
  1. S TDT=$O(^RCPS(349.2,0)) I TDT D
  1. .S TDT=$$ASOF^RCCPCFN($P($G(^RCPS(349.2,+TDT,0)),"^",10))
  1. .S TDT=$TR($$SLH^RCFN01(TDT),"/","")
  1. .S TDT("T")=$P($G(^RCT(349,1,0)),"^",10),TDT("T")=$E(TDT("T"),1,4)_$E(TDT("T"),7,8)
  1. .I TDT("T")=TDT D
  1. ..W *7,!,"The current file reflects activity as of ",$E(TDT,1,2)_"/"_$E(TDT,3,4)_"/"_$E(TDT,5,8)_".",!
  1. ..W !,"IT WAS TRANSMITTED ON ",$TR($P($P($G(^RCT(349,1,0)),"^"),".",2,4),".","/"),!
  1. ..S TDT=$P($G(^RCT(349,1,0)),"^",9)
  1. ..W !,"For statement date: ",$E(TDT,1,2)_"/"_$E(TDT,3,4)_"/"_$E(TDT,5,8)
  1. ..W !!,"PLEASE CONTACT CUSTOMER SUPPORT BEFORE PROCEEDING.",!!
  1. TIME S ZTIO="",ZTRTN="EN^RCCPCPS",ZTDESC="Build CCPC Statement File"
  1. S ZTDTH="" D ^%ZTLOAD Q:$G(ZTSK)=""
  1. S %H=ZTSK("D") D YX^%DTC,H^%DTC I %Y=0!(%Y=6) W !,"Queued for Building." Q ;PRC*4.5*348
  1. S %H=ZTSK("D") D YMD^%DTC S QDT=X_%
  1. I (QDT>(X_".0800"))&(QDT<(X_".1801")) D G TIME ;PRC*4.5*348
  1. .W !!,*7,"You Can Not Queue this Job on a weekday Between 8:00am and 6:00pm.",!
  1. .D KILL^%ZTLOAD
  1. W !,"Queued for Building."
  1. Q
  1. ;
  1. RCDESC ;Remove "IN PART" & "IN FULL" from the the bill description
  1. QUIT:$G(RCDESC(1))=""
  1. S RCINFULL=" (IN FULL)"
  1. S RCINPART=" (IN PART)"
  1. I RCDESC(1)[RCINFULL S RCDESC(1)=$P(RCDESC(1),RCINFULL)_$P(RCDESC(1),RCINFULL,2)
  1. I RCDESC(1)[RCINPART S RCDESC(1)=$P(RCDESC(1),RCINPART)_$P(RCDESC(1),RCINPART,2)
  1. Q
  1. ;
  1. RCCPOSST ; ;PRCA*4.5*401 Sends external email to Mail group to notify there are statements to print
  1. N RCDEBIEN,CNT,LINE,XMDUZ,XMTEXT,XMY,XMSUB
  1. S (RCDEBIEN,CNT)=0
  1. K ^TMP($J,"RCCPSTMTMSG")
  1. F S RCDEBIEN=$O(^RCD(340,"ALOCAL",1,RCDEBIEN)) Q:RCDEBIEN="" S CNT=CNT+1
  1. I CNT=0 Q
  1. S XMSUB="OVER SIZE STATEMENTS TO PRINT"
  1. S LINE=0
  1. S LINE=LINE+1,^TMP($J,"RCCPSTMTMSG",LINE)="There are "_CNT_" Oversized statements waiting to be printed."
  1. S XMTEXT="^TMP($J,""RCCPSTMTMSG"","
  1. ;S XMDUZ=$O(^VA(200,"B","POSTMASTER",0))
  1. S XMDUZ=.5
  1. S XMY("G.RCCPC EXTERNAL")=""
  1. D ^XMD
  1. Q
  1. ;
  1. FILEOSFG(RCDEBTDA,RCFT) ; ;PRCA*4.5*401 Set/Clear LOCAL PRINT flag, in file 340, to:
  1. ; Yes, i.e. 1 if RCFT="S"
  1. ; No, i.e. 0 if RCFT="C"
  1. ; RCDEBTDA = File 340 IEN
  1. ; RCFT = Filing Type (S Set or C Clear)
  1. ;
  1. ;VBLLST format - Principal Balance / Interest / Admin Fees / Court Costs / Marshal Fees / Date statement printed
  1. ;
  1. N DIE,DA,DR,VBLLST
  1. I RCFT="S" S DIE="^RCD(340,",DA=RCDEBTDA,DR="112///Y"
  1. I RCFT="C" S DIE="^RCD(340,",DA=RCDEBTDA,DR="112///N"
  1. D ^DIE
  1. I RCFT="S" D
  1. . S VBLLST=BBAL("PB")_"/"_BBAL("INT")_"/"_BBAL("ADM")_"/"_BBAL("CT")_"/"_BBAL("MF")_"/"_$$NOW^XLFDT
  1. . S DIE="^RCD(340,",DA=RCDEBTDA,DR="113///"_VBLLST
  1. I RCFT="C" S DIE="^RCD(340,",DA=RCDEBTDA,DR="113///@"
  1. D ^DIE
  1. K DIE,DA,DR
  1. Q
  1. ;
  1. CLRSTMTQ ;;PRCA*4.5*401 Clear Oversize statement queue
  1. N RCIEN,RCFT
  1. N DIR,X,Y,DA,DTOUT,DUOUT,DIRUT,DIROUT
  1. S RCFT="C",RCIEN=""
  1. ; Loop through AR DEBTOR "C" index and clear all that are set to Yes
  1. S DIR("A",1)="*** Clearing the queue at this time will prevent these"
  1. S DIR("A",2)=" statements from printing again to the Statement Printer"
  1. S DIR("A",3)=" through this option."
  1. S DIR("A",4)=" "
  1. S DIR("A")="Are you sure you want to clear this print queue? (Y/N)"
  1. S DIR(0)="Y",DIR("B")="N",DIR("T")=30
  1. D ^DIR
  1. I Y'=1 W !,"Nothing done" H 2 Q
  1. F S RCIEN=$O(^RCD(340,"ALOCAL",1,RCIEN)) Q:RCIEN="" D
  1. . D FILESTAT(RCIEN)
  1. . D FILEOSFG(RCIEN,RCFT)
  1. W !!,"Local Statement Queue has been cleared" H 2
  1. Q
  1. ;
  1. FILESTAT(DEB); ;PRCA*4.5*401 File
  1. ; INPUT: DEB - Debtor IEN (file 340)
  1. ;
  1. ;VBLLST format - Principal Balance / Interest / Admin Fees / Court Costs / Marshal Fees / Date statement printed
  1. ;
  1. N VBLLST,BBAL,END,ERR,EVN
  1. S VBLLST=$$GET1^DIQ(340,DEB_",",113,"I") ;Recall saved BBAL array as string
  1. ; Parse BBAL array from string VBLLST
  1. S BBAL("PB")=$P(VBLLST,"/",1),BBAL("INT")=$P(VBLLST,"/",2),BBAL("ADM")=$P(VBLLST,"/",3)
  1. S BBAL("CT")=$P(VBLLST,"/",4),BBAL("MF")=$P(VBLLST,"/",5)
  1. ;Set End to the day the process ran rather than the day the statements were actually printed to avoid out of balance issues.
  1. S END=$P(VBLLST,"/",6)
  1. 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"))
  1. I EVN D CLOSE^RCEVDRV1(EVN)
  1. D UPDAT^PRCAGU(DEB,DT) ;set bill letter field
  1. Q