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

RCTCSPRS.m

Go to the documentation of this file.
  1. RCTCSPRS ;ALBANY/BDB - CROSS-SERVICING (RECONCILIATION SERVER);02/19/14 3:21 PM
  1. ;;4.5;Accounts Receivable;**301,315,336**;Mar 20, 1995;Build 45
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;Program to process reconciliation server messages from AITC
  1. ;
  1. ;PRCA*4.5*336 Use a different work file ^XTMP('RCTCSPRSW') to avoid
  1. ; any contention with weekly CS batch run RCTCSPD.
  1. ; Also, the clearing of the CS flag for debtor when
  1. ; no longer having any CS bills has been REMOVED.
  1. ;
  1. READ ;READS MESSAGE INTO TEMPORARY GLOBAL
  1. N FDT,RDNODE S FDT=0
  1. K ^XTMP("RCTCSPDW",$J) ;PRCA*4.5*336
  1. ;New report for claims returned from treasury PRCA*4.5*315
  1. S ^XTMP("RCTCSP5 - "_DT,0)=$$FMADD^XLFDT(DT,57)_"^"_DT_"^"_"Treasury Cross-Servicing IAI Report" ; Maintain this entry for 57 days
  1. S RDNODE=$NA(^XTMP("RCTCSP5 - "_DT))
  1. ;
  1. S XMA=0
  1. READ1 X XMREC I $D(XMER) G:XMER<0 READQ
  1. I $E(XMRG,1)="H" S FDT=$E(XMRG,2,9)
  1. S ^XTMP("RCTCSPRS",$J,"READ",FDT,XMPOS)=XMRG
  1. G READ1
  1. ;
  1. READQ K XMA,XMER,XMREC,XMPOS,XMRG
  1. N TYPE,VALC,VFASTCD,VSTTN,VSITE,LN,REC,REC1,REC2
  1. S VALC="36001200"
  1. S VFASTCD="36"
  1. S VSTTN="DM1D "
  1. S VSITE=$E($$SITE^RCMSITE(),1,3)
  1. S LN=0
  1. F S LN=$O(^XTMP("RCTCSPRS",$J,"READ",FDT,LN)) Q:LN="" S REC1=$G(^(LN)),LN=LN+1,REC2=$G(^(LN)),REC=$E(REC1,1,225)_$E(REC2,1,225) D
  1. .S TYPE=$E(REC,1,2)
  1. .I TYPE["H" D HDR Q
  1. .I TYPE="A1" D A1 Q
  1. .I TYPE="C1" Q
  1. .I TYPE="R1" D R1 Q
  1. .I TYPE="R2" D R2 Q
  1. .I TYPE["Z" K TYPE Q
  1. .Q
  1. ;
  1. TRDT ;sends mailman message to user for returned debts
  1. Q:'$D(^XTMP("RCTCSPDW",$J,"TRDTRDB"))
  1. S XMDUZ="AR PACKAGE",XMY("G.TCSP")=""
  1. N TCT1,TDEB1,TDEB10,TBIL1,TSP1,FST1,TBCNT,TTXT1
  1. S XMSUB="CS QUALIFIED/RETURNED DEBTS "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
  1. S ^XTMP("RCTCSPDW",$J,"TRDT",1)="The following Debtors and Debts were Returned by Reconciliation."
  1. S ^XTMP("RCTCSPDW",$J,"TRDT",2)=""
  1. S ^XTMP("RCTCSPDW",$J,"TRDT",3)="Name Bill # Returned Date Closed Date"
  1. S ^XTMP("RCTCSPDW",$J,"TRDT",4)="---- ------ -------- ---- ------ ----"
  1. S TCT1=5,TSP1=0,TDEB1="",TBCNT=0
  1. F S TDEB1=$O(^XTMP("RCTCSPDW",$J,"TRDTRDB",TDEB1)) Q:TDEB1="" D
  1. .S FST1=1,TBIL1=""
  1. .I FST1,TCT1'=5 S ^XTMP("RCTCSPDW",$J,"TRDT",TCT1)="",TCT1=TCT1+1,TSP1=TSP1+1
  1. .F S TBIL1=$O(^XTMP("RCTCSPDW",$J,"TRDTRDB",TDEB1,TBIL1)) Q:TBIL1="" S TBCNT=TBCNT+1 D
  1. ..S TDEB10=$S(FST1:TDEB1,1:""),TTXT1=""
  1. ..F S TTXT1=$O(^XTMP("RCTCSPDW",$J,"TRDTRDB",TDEB1,TBIL1,TTXT1)) Q:TTXT1="" S ^XTMP("RCTCSPDW",$J,"TRDT",TCT1)=^XTMP("RCTCSPDW",$J,"TRDTRDB",TDEB1,TBIL1,TTXT1) S TCT1=TCT1+1
  1. ..S TCT1=TCT1+1,FST1=0
  1. S ^XTMP("RCTCSPDW",$J,"TRDT",TCT1)="Total records: "_TBCNT
  1. S XMTEXT="^XTMP(""RCTCSPDW"","_$J_",""TRDT"","
  1. D ^XMD K XMDUZ,XMSUB,XMTEXT,XMY
  1. K ^XTMP("RCTCSPDW",$J,"TRDT")
  1. TRDTQ Q
  1. ;
  1. HDR ; header record
  1. S TFASTCD=$E(REC,10,11),TALC=$E(REC,12,19) ;repeated on r1 AND r2
  1. Q
  1. ;
  1. A1 ;active debt record
  1. N TFASTCD,TALC,TSTTN,TDBTID,TSITE,BILL,B0,DEBTOR
  1. S TFASTCD=$E(REC,3,4),TALC=$E(REC,5,12),TSTTN=$E(REC,13,17),TDBTID=$E(REC,18,47),TRDT=$E(REC,58,65)
  1. I TFASTCD'=VFASTCD D NPMSG("FASTCD",TFASTCD,VFASTCD) Q
  1. I TALC'=VALC D NPMSG("ALC",TALC,VALC) Q
  1. I TSTTN'=VSTTN D NPMSG("STATION",TSTTN,VSTTN)
  1. S TSITE=$E(TDBTID,1,3) I TSITE'=VSITE D NPMSG("SITE",TSITE,VSITE) Q
  1. S BILL=+$E(TDBTID,12,30) ;BILL = IEN
  1. S B0=$G(^PRCA(430,BILL,0))
  1. S DEBTOR=+$P(B0,U,9)
  1. ;PRCA*4.5*315 set data for IAI report (^RCTCSP5)
  1. I DEBTOR,BILL S @RDNODE@(DEBTOR,BILL)="" ;set to debtor then bill IEN for sorting the IAI report
  1. Q
  1. ;
  1. R1 ;returned debt record
  1. N TFASTCD,TALC,TSTTN,TDBTID,TRDT,TSITE,BILLNO,BILL,B0,B4,B6,B7,B9,B14,B15,B16,DEBTOR,RJND
  1. S TFASTCD=$E(REC,3,4),TALC=$E(REC,5,12),TSTTN=$E(REC,13,17),TDBTID=$E(REC,18,47),TRDT=$E(REC,58,65)
  1. I TFASTCD'=VFASTCD D NPMSG("FASTCD",TFASTCD,VFASTCD) Q
  1. I TALC'=VALC D NPMSG("ALC",TALC,VALC) Q
  1. I TSTTN'=VSTTN D NPMSG("STATION",TSTTN,VSTTN)
  1. S TSITE=$E(TDBTID,1,3) I TSITE'=VSITE D NPMSG("SITE",TSITE,VSITE) Q
  1. S BILLNO=$E(TDBTID,4,10),BILL=+$E(TDBTID,11,30) ;BILL = IEN
  1. S B0=$G(^PRCA(430,BILL,0)),B4=$G(^(4)),B6=$G(^(6)),B7=$G(^(7)),B9=$G(^(9)),B14=$G(^(14)),B15=$G(^(15)),B16=$G(^(16))
  1. S DEBTOR=$P(B0,U,9)
  1. ;set comment transaction in 433
  1. D CSPRTR^RCTCSPD5 ;PRCA*4.5*315
  1. ;
  1. S RJND=0 F S RJND=$O(^PRCA(430,BILL,18,RJND)) Q:'RJND D
  1. .N DAT
  1. .S DAT=+$G(^PRCA(430,BILL,18,RJND,0))
  1. .I DAT K ^PRCA(430,"AB",DAT,BILL)
  1. K ^PRCA(430,BILL,15),^(16),^(17),^(18),^(19),^(20)
  1. I +TRDT D
  1. .N DNM,DA,DIE,DR
  1. .I $D(^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,1)) S $E(^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,1),52,63)=$$DTT2E(TRDT) Q
  1. .S DNM=$E($$NAMEFF(+^RCD(340,DEBTOR,0)),1,30),DNM=$$LJSF(DNM,30)
  1. .S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,1)=$$LJSF(DNM,30)_" "_$$LJSF(BILLNO,7)_" "_$$DTT2E(TRDT)
  1. .S EFFDT=$$HL7TFM^XLFDT(TRDT),REASON="O",COMMENT="BY RECONCILIATION"
  1. .S $P(^PRCA(430,BILL,15),U,7,10)="1^"_EFFDT_U_REASON_U_$G(COMMENT)
  1. .S DIE="^PRCA(430,",DA=BILL
  1. .S DR="301////"_EFFDT ;Returned date
  1. .S DR=DR_";310////"_$P(B16,U,9)
  1. .S DR=DR_";311////"_$P(B16,U,10)
  1. .S DR=DR_";312////"_$P(B15,U,3)
  1. .D ^DIE
  1. K ^PRCA(430,"TCSP",BILL) ;set the bill to not sent to cross-servicing
  1. Q
  1. ;
  1. R2 ;returned debtor record
  1. N TFASTCD,TALC,TSTTN,TDBTID,TSITE,TFDA,TDBTORID,TRRSNCD,TCMPIND,TCMPAMT,TCLSDT,TBNKDT,TDTHDT,TDISDT,RJND
  1. S TFASTCD=$E(REC,3,4),TALC=$E(REC,5,12),TSTTN=$E(REC,13,17),TDBTID=$E(REC,18,47),TDBTORID=$E(REC,48,62),TRRSNCD=$E(REC,261,262)
  1. S TCMPIND=$E(REC,263,263),TCMPAMT=$E(REC,264,277),TCLSDT=$E(REC,278,285),TBNKDT=$E(REC,286,293),TDTHDT=$E(REC,294,301),TDISDT=$E(REC,302,309)
  1. I TFASTCD'=VFASTCD D NPMSG("FASTCD",TFASTCD,VFASTCD) Q
  1. I TALC'=VALC D NPMSG("ALC",TALC,VALC) Q
  1. I TSTTN'=VSTTN D NPMSG("STATION",TSTTN,VSTTN)
  1. S TSITE=$E(TDBTID,1,3) I TSITE'=VSITE D NPMSG("SITE",TSITE,VSITE) Q
  1. S BILLNO=$E(TDBTID,4,10),BILL=+$E(TDBTID,11,30)
  1. S B0=$G(^PRCA(430,BILL,0))
  1. S TRRSNCD=$$CLRBLNK(TRRSNCD)
  1. S DEBTOR=$P(B0,U,9)
  1. S RJND=0 F S RJND=$O(^PRCA(430,BILL,18,RJND)) Q:'RJND D
  1. .N DAT
  1. .S DAT=+$G(^PRCA(430,BILL,18,RJND,0))
  1. .I DAT K ^PRCA(430,"AB",DAT,BILL)
  1. K ^PRCA(430,BILL,15),^(16),^(17),^(18),^(19),^(20)
  1. I TRRSNCD]"" D
  1. .N DNM,EFFDT,REASON,COMMENT
  1. .I $D(^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,1)) S $E(^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,1),68,79)=$S($G(TCLSDT)]"":$$DTT2E(TCLSDT),1:"")
  1. .I '$D(^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,1)) D
  1. ..S DNM=$E($$NAMEFF(+^RCD(340,DEBTOR,0)),1,30),DNM=$$LJSF(DNM,30),^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,1)=DNM_" "_$$LJSF(BILLNO,7)_" "_$S($G(TCLSDT)]"":$$DTT2E(TCLSDT),1:"")
  1. .S DIC="^PRCA(430.5,",DIC(0)="Z",X=TRRSNCD D ^DIC K DIC I +Y>0 D
  1. ..S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,2)=" "_$P(Y(0),U,2)
  1. ..S $P(^PRCA(430,BILL,30),U,2)=+Y
  1. I TCMPIND="Y" D
  1. .S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,3)=" COMPROMISE, PLEASE WRITE THIS BILL OFF BY THE MANUAL PROCESS."
  1. .S $P(^PRCA(430,BILL,30),U,3)=TCMPIND
  1. .I +TCMPAMT D
  1. ..S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,4)=" COMPROMISED AMOUNT (NOT COLLECTED):"_$J(TCMPAMT/100,9,2)
  1. ..S $P(^PRCA(430,BILL,30),U,4)=TCMPAMT/100
  1. I +TBNKDT D
  1. .S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,5)=" BANKRUPTCY DATE: "_$$DTT2E(TBNKDT)
  1. .S $P(^PRCA(430,BILL,30),U,6)=$$HL7TFM^XLFDT(TBNKDT)
  1. I +TDTHDT D
  1. .S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,6)=" DATE OF DEATH: "_$$DTT2E(TDTHDT)
  1. .S $P(^PRCA(430,BILL,30),U,7)=$$HL7TFM^XLFDT(TDTHDT)
  1. I +TDISDT D
  1. .S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,7)=" DATE OF DISSOLUTION: "_$$DTT2E(TDISDT)
  1. .S $P(^PRCA(430,BILL,30),U,8)=$$HL7TFM^XLFDT(TDISDT)
  1. I +TCLSDT D
  1. .S EFFDT=$$HL7TFM^XLFDT(TCLSDT),REASON="O",COMMENT="BY RECONCILIATION"
  1. .S $P(^PRCA(430,BILL,15),U,7,10)="1^"_EFFDT_U_REASON_U_$G(COMMENT)
  1. .S $P(^PRCA(430,BILL,30),U,5)=$$HL7TFM^XLFDT(TCLSDT)
  1. K ^PRCA(430,"TCSP",BILL) ;set the bill to not sent to cross-servicing
  1. S ^XTMP("RCTCSPDW",$J,"TRDTRDB",DEBTOR,BILL,8)=""
  1. Q
  1. ;
  1. NPMSG(FLD,TCD,VCD) ;error not processed
  1. Q
  1. ;
  1. LJSF(X,Y) ;left justified space filled
  1. S X=$E(X,1,Y)
  1. S X=X_$$BLANK(Y-$L(X))
  1. Q X
  1. ;
  1. BLANK(X) ;returns 'x' blank spaces
  1. N BLANK
  1. S BLANK="",$P(BLANK," ",X+1)=""
  1. Q BLANK
  1. ;
  1. CLRBLNK(X) ;clear blanks
  1. S X=$TR(X," ","")
  1. Q X
  1. ;
  1. NAMEFF(DFN) ;returns name for document and name in file
  1. N FN,LN,MN,NM,DOCNM,VA,VADM
  1. S NM=""
  1. D DEM^VADPT
  1. I $D(VADM) S NM=VADM(1)
  1. S LN=$TR($P(NM,",")," .'-"),MN=$P($P(NM,",",2)," ",2)
  1. I ($E(MN,1,2)="SR")!($E(MN,1,2)="JR")!(MN?2.3"I")!(MN?0.1"I"1"V"1.3"I") S MN=""
  1. S FN=$P($P(NM,",",2)," ")
  1. S DOCNM=LN_" "_FN_" "_MN
  1. Q DOCNM
  1. ;
  1. DTT2E(TDT) ;date treasury to external format
  1. Q $$UPPER^VALM1($$FMTE^XLFDT($$HL7TFM^XLFDT(TDT)))