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