RCTCSJS0 ;ALBANY/RGB - CROSS-SERVICING REJECTS SERVER;02/19/14 3:21 PM
V ;;4.5;Accounts Receivable;**343**;Mar 20, 1995;Build 59
;;Per VA Directive 6402, this routine should not be modified.
;Program to process CS REJECT server messages from AITC
;
;===================================================================
;
SERVER ; entry from outside
D INIT1
S:'$L(XMZ1) XMZ1=$S($L(XMZ2):XMZ2,1:" ")
S:'$L(XMZ2) XMZ2=$S($L(XMZ1):XMZ1,1:" ")
I '$G(XMZ1)!'$G(XMZ2) D G END
. D RECERR(.ERRCNT,"Inv MM MSG","Invalid MM Msg# '"_$G(XMZ1)_"'"_$S(XMZ2'=XMZ1:" to '"_XMZ2_"'",1:""),0,.RECERR)
I '$D(^XMB(3.9,XMZ1))!'$D(^XMB(3.9,XMZ2)) D G END
. D RECERR(.ERRCNT,"Inv MM MSG","Invalid MM Msg# '"_$G(XMZ1)_"'"_$S(XMZ2'=XMZ1:" to '"_XMZ2_"'",1:""),0,.RECERR)
;
K LIST F XMZ=XMZ1:1:XMZ2 S LIST(XMZ)=""
I '$D(LIST) D RECERR(.ERRCNT,"BAD QUEUE","No Valid MM Msgs are for REJECTS Queues for MM Msg: "_XMZ,0,.RECERR) G END
F XMZ=XMZ1:1:XMZ2 I $D(LIST(XMZ)) D ;
. K ^XTMP(NMSPC,$J,"BILL")
. K ^XTMP(NMSPC,$J,"REC")
. S QNAM=$G(^XMB(3.9,XMZ,2,1,0)) ; Queue Name
. I $D(^XMB(3.9,XMZ)) D ;
.. S BATFDT=$G(^XMB(3.9,XMZ,.6))
.. S LSTREC=$P($G(^XMB(3.9,XMZ,2,0)),U,3) ; last record# of data
.. S XNRECS=$P($G(^XMB(3.9,XMZ,2,0)),U,4) ; #records expected from file
.. S HDR=$G(^XMB(3.9,XMZ,2,2,0)) ; AITC Header record
.. S BCIDA=$E(HDR,2,9) ; AITC Batch Control ID
.. I 'XNRECS!'$L(HDR) D Q ;
... D RECERR(.ERRCNT,"NO RECS/HDR","No Records Found: '"_XNRECS_"'",0,.RECERR)
.. D START
END ;
I '$D(^XTMP(NMSPC,$J,"BULTN")) D ;
. S BLTNCNT=$G(BLTNCNT)+1
. S ^XTMP(NMSPC,$J,"BULTN",BLTNCNT)=" "
. S BLTNCNT=$G(BLTNCNT)+1
. S BLTNREC="NOTE: NO UNPROCESSABLE/REJECT RECORDS FOUND NEEDING TO BE PROCESSED"
. S ^XTMP(NMSPC,$J,"BULTN",BLTNCNT)=BLTNREC
D SENDBUL^RCTCSJS1
I $D(^XTMP(NMSPC,$J,"ERR")) D SENDERR^RCTCSJS1
D CLEANUP^RCTCSJS1
Q ; ENTER
;
INIT1 ; initialize first time
S NMSPC="RCTCSJS"
S CSRCS=""
S XMZ1=$P($G(XMZ),"-")
S XMZ2=$P($G(XMZ),"-",2)
K ^XTMP(NMSPC,$J)
K TOTAMT,ARTXNID
S U="^"
S STATCNT=0 ; STATUS logging count
D NOW^%DTC
S (X1,RUNDT)=X,RUNDTTM=%
S X2=30 D C^%DTC
S ^XTMP(NMSPC,$J,0)=X_U_RUNDT_U_"CS REJECT FILE PROCESSING/"_DUZ
S ERRCNT=0 ; ERROR logging count
S NULLERR="",$P(NULLERR," ",19)="" ; for no error codes
S BLNKS="",$P(BLNKS," ",25)=""
S BLTNCNT=0
S SITE=$$SITE^RCMSITE()
Q ; INIT1
;
INIT2 ; subsequent inits
S CRCNT=0 ; "C" records count
S TOTAMT=0 ; Total Amount of Referred Balance
N I ; new variables
;
S LSTREC=$P($G(^XMB(3.9,XMZ,2,0)),U,3) ; last record# of data
S XNRECS=$P($G(^XMB(3.9,XMZ,2,0)),U,4) ; #records expected from file
S HDR=$G(^XMB(3.9,XMZ,2,2,0)) ; AITC Header record
S BCIDA=$E(HDR,2,9) ; AITC Batch Control ID
I 'XNRECS!'$L(HDR) D Q ;
. D RECERR(.ERRCNT,"NO RECS/HDR","No Records Found: '"_XNRECS_"'",0,.RECERR)
Q ; INIT2
;
START ; start of process
D INIT2
D XMB2XTMP ; moves MM data from ^XMB(3.9,... to ^XTMP
D SRTXTMP ; sorts recs from ^XTMP into by Debtor, by BILL
S STOPSET="" ; flag to determine if data is error free (or not)
I RECNS'=XNRECS D ; logs MailMan record COUNT error
. S ZMSG="Expected MM RECS: '"_XNRECS_"' not same as # RECS FOUND: '"_RECNS_"'"
. D RECERR(.ERRCNT,"RECNUMS",ZMSG,RECNS,.RECERR)
. S STOPSET=1
TOT ;
I $TR(TOTAMT,"-+","")'=(+ZTOTA*.01) D ; logs record Total Amt error
. S X=TOTAMT,X2="2$",X3=4 D COMMA^%DTC S TOTAMOUT=$TR(X," ","")
. S X=ZTOTA*.01,X2="2$",X3=4 D COMMA^%DTC S ZTOTAOUT=$TR(X," ","")
. S ZMSG="Expected $Amt: '"_ZTOTAOUT_"' = ACCUMULATED AMT found: '"_TOTAMOUT_"'"
. D RECERR(.ERRCNT,"TOTAL $ AMT",ZMSG,RECNS,.RECERR)
. S STOPSET=STOPSET_2
I CRCNT'=+$G(ZRCNT) D ; logs record COUNT error
. S ZMSG="Z record RECS: '"_$G(ZRCNT)_"' not same as # RECS FOUND: '"_CRCNT_"'"
. D RECERR(.ERRCNT,"Z-REC-CNTS",ZMSG,RECNS,.RECERR)
. S STOPSET=STOPSET_3
I STOPSET S STOPMSG="" D Q ; whole file error detected, DO NOT PROCESS REJECTS
. F I=1:1:3 I STOPSET[I D ;
.. I I[1 S STOPMSG="(#MM RECS("_XNRECS_") not same as #Recs found("_RECNS_")"
.. I I[2 S STOPMSG="(ZTOTAMT("_(+$G(ZTOTA)*.01)_") = Amt found("_TOTAMT*100_")"
.. I I[3 S STOPMSG="(#Z RECCNT("_$G(ZRCNT)_") not = #C Recs found("_CRCNT_")"
.. S ZMSG="BILL Records NOT Updated: "_STOPMSG
.. D RECERR(.ERRCNT,"FILE ERR",ZMSG,RECNS,.RECERR)
I '$D(^XTMP(NMSPC,$J,"BILL")) D Q ; logs NO VALID BILLS found error
. S ZMSG="Found NO REJECT Bill Errors"
. D RECERR(.ERRCNT,"NO BILLS",ZMSG,0,.RECERR)
D SETREJS^RCTCSJS
Q ; START
;
XMB2XTMP ;copies ^XMB(3.9,XMZ) to ^XTMP
M ^XTMP(NMSPC,$J,"READ",BCIDA)=^XMB(3.9,XMZ,2)
Q ; XMB2XTMP
;
SRTXTMP ;sorts ^XTMP(...,"READ" recs into ^XTMP(..."BILL" which is sorted by Debtor ID, by BILL
F RECN=2:2 Q:'$D(^XTMP(NMSPC,$J,"READ",BCIDA,RECN)) D ;
. S NOTPROC=""
. K CERRS
. S RECERR=0
. S REC1=^XTMP(NMSPC,$J,"READ",BCIDA,RECN,0)
. S REC2=^XTMP(NMSPC,$J,"READ",BCIDA,RECN+1,0)
. S REC=$P(REC1,"^")_$P(REC2,"~") ; eliminate record delimiters
. Q:$E(REC,1,4)="NNNN"
. S RID=$E(REC) ; (H,C,Z)
. S RTYP=$TR($E(REC,2,3)," ","") ; eliminate spaces
. I RID="C",",1,2,2A,2B,2C,2D,2E,3,4,5A,5B,6,"'[(","_RTYP_",") D Q ; logs RTYP error
.. S CBILL=$E(REC,20,29)
.. S ZMSG="Invalid Record TYPE Received: '"_RTYP_"' from Record: "_CBILL_", record# "_RECN
.. D RECERR(.ERRCNT,"INV REC TYPE",ZMSG,RECN,.RECERR)
. S RACTN=$E(REC,4) ; (A,B,D,L,U,V)
. I $L(REC)'=471 D Q ; logs record LEN error
.. D RECERR(.ERRCNT,"RECLEN","Record Length Error: "_$L(REC),RECN,.RECERR)
. D @RID
. Q:RECERR ; quit, process err detected and logged via RECERR
. Q:$G(CERRS(RTYP))=NULLERR!'$D(CERRS(RTYP)) ; ignore, no errors in this record
. I CERRS(RTYP)["9A" S REFBATCH=$E(CERRS(RTYP),11,18) D ;
.. S ZMSG="Invalid Referral Batch: '"_REFBATCH_"' from Message: '"_XMZ_"'"
.. D RECERR(.ERRCNT,"INV REF BATCH",ZMSG,RECN,.RECERR)
.. S ERRSFND("9A",REFBATCH,XMZ)=""
. I '$G(SAMESITE) D ;
.. S ZMSG="Expecting: '"_SITE_"', Found: '"_SITENUM_"'/"_CBILL_"/"_RID_RTYP
.. D RECERR(.ERRCNT,"WRONG REC SITE",ZMSG,RECN,.RECERR)
. Q:'$G(SAMESITE) ; ignore, this record belongs to a different site
. ; Q:$G(NOTPROC) ; last Z record shows first THRU last batches were not all completely satisfied
. ;
. I RID="C" D LOGREJS
S RECNS=RECN-1
Q ; SRTXTMP
;
C S CRCNT=CRCNT+1
S CERRS(RTYP)=$E(REC,452,469)
F PC=1:2 S CHKEC=$E(CERRS(RTYP),PC,PC+1) Q:CHKEC="" Q:CHKEC=" " I '$D(^RC(348.5,"B",CHKEC)) D ;
. S ZMSG="Invalid Error Code: '"_CHKEC_"' in Batch: "_BCIDA_"/"_RID_RTYP
. S ERR=1 D RECERR(.ERRCNT,"INV ERR CODE",ZMSG,RECN,.RECERR)
S CSRC=$E(REC,470),CSRC=$S(CSRC=" ":"T",1:CSRC)
I CSRCS'[CSRC S CSRCS=CSRCS_CSRC
S LBL="L"_RTYP
D @LBL ; perform record type parsing of data
Q ; C
H ; Header record
S BCIDA=$E(REC,2,9)
S HREC=REC
S HFAST=$E(REC,24,25),HALC=$E(REC,26,33),HERRS=$E(REC,452,469),HSRC=$E(REC,470,471)
S H4DATE=$E(BCIDA,1,4),HSEQ=$E(BCIDA,5,9) ; (note: H4DATE is Y_DOY)
D DOY2EXT(H4DATE,.HDATE)
I HDATE'?7N S ERR=1 D RECERR(.ERRCNT,"INV DATE","Invalid Date: '"_HDATE_"' /"_RID_RTYP,RECN,.RECERR) Q ;
I HERRS'=NULLERR S FILERR=$E(HERRS,1,10),BCIDV=$E(HERRS,11,18)
Q ; H
Z ; Trailer record
S ZREC=REC
S ZRCNT=$E(REC,2,9),ZTOTA=$E(REC,10,23)
S Z4DOY=$E(REC,24,27)
S ZSEQ=$E(REC,28,31)
S ZFAST=$E(REC,46,47),ZALC=$E(REC,48,55)
S ZERRS=$S($E(REC,452)'=" ":$E(REC,452,469),1:NULLERR)
S ZBAT1=$E(REC,459,462),ZBAT2=$E(REC,463,466)
S ZSRC=$E(REC,470,471)
D DOY2EXT(Z4DOY,.ZDATE)
Q ; Z
DOY2EXT(YDOY,ZDATE) ; gets Date from DOY;
N X
S ZLYR=$E(YDOY),ZDOY=$E(YDOY,2,4)
S %H=$H D YX^%DTC
S X1=$S($E(X,3)=ZLYR:$E(X,1,3)-1,$E(X,3)<ZLYR:$E(X,1,2)_ZLYR-11,$E(X,3)>ZLYR:$E(X,1,2)_ZLYR-1)_"1231"
S X2=ZDOY D C^%DTC
S NX=X
S ZDATE=$S(ZDOY>365&($E(X,4,7)'="1231"):-1,1:NX) ; error if DOY >365 and not a Leap Year
Q ; DOY2EXT
;
L1 ; Debt Record
S CORIGD=$E(REC,77,90)*.01,CREFBAL=$TR($E(REC,91,104),"-","0")*.01
S TOTAMT=$G(TOTAMT)+CREFBAL
D GETPCS1
Q ; L1
L2 ;; Debtor Record
S CDEBTIN=$E(REC,65,73),CDEBNAML=$E(REC,77,111),CDEBNAMF=$E(REC,112,146)
S CDEBNAMM=$E(REC,147,181)
D GETPCS1
Q ;L2
L2A ;; Individual Debtor Record
S CDEBSEX=$E(REC,68),CDOB=$E(REC,69,76)
D GETPCS1
Q ;L2A
L2B ; Business Debtor Record
D GETPCS1
Q ; L2B
L2C ; Debtor Contact Information
S CDEBTIN=$E(REC,65,73)
D GETPCS1
Q ; L2C
L2D ; Debtor Record (Property Information)
D GETPCS1
Q ; L2D
L2E ; Debtor Record (Employment Information for Individual Debtor)
D GETPCS1
Q ; L2E
L3 ; Case Record
D GETPCS1
Q ; L3
L4 ; Alias Name
S CDEBTIN=$E(REC,65,73)
D GETPCS1
Q ; L4
L5A ; Creditor Agency Financial Transactions (Collections)
S CTRAMT=$E(REC,117,130)*.01,CORIGPMT=$E(REC,117,130)*.01
S TOTAMT=+$G(TOTAMT)+($TR($E(REC,117,130),"-","0")*.01)
D GETPCS2
Q ; L5A
L5B ; Creditor Agency Financial Transactions (Adjustments)
S CSPAMT=$E(REC,117,130)*.01,CSTAMT=$E(REC,173,186)*.01
S CSTADJ=$E(REC,211,224)*.01
S TOTAMT=+$G(TOTAMT)+($TR($E(REC,173,186),"-","0")*.01)
D GETPCS2
S ARTXNID=$E(REC,93,107),ARTXNID(CDEBTIEN)=+ARTXNID_U_CBILL_U_RECN
Q ; L5B
L6 ; Payment Bypass/Offset
S CDEBTIN=$E(REC,65,73)
D GETPCS1
Q ; L6
;
LOGREJS ; compiles the varied reject errors by BILL
K Z
S CERRS=$P($G(^XTMP(NMSPC,$J,"BILL",CDEBTIEN,CBILL,HDATE,CSRC,RTYP,RACTN)),U)
F I=2:2:18 S ERR=$E(CERRS(RTYP),I-1,I) Q:ERR=" " D ;
. I '$D(^RC(348.5,"B",ERR)) D Q ;
.. S ZMSG="Unknown Error Code: '"_ERR_"', FOUND IN: "_CBILL_"/"_RID_RTYP
.. D RECERR(.ERRCNT,"UNK ERR CD",ZMSG,RECN,.RECERR)
. S:CERRS'[ERR CERRS=CERRS_ERR_"," ; captures new errs
I $L(CERRS) S ^XTMP(NMSPC,$J,"BILL",CDEBTIEN,CBILL,HDATE,CSRC,RTYP,RACTN)=CERRS_U_$G(ARTXNID(CDEBTIEN,CBILL))
Q ; LOGREJS
;
GETPCS1 ;
Q:CERRS(RTYP)=NULLERR
S CDEBTID=$E(REC,20,49)
S SITENUM=$E(CDEBTID,1,3)
S SAMESITE=$S(SITENUM=SITE:1,1:0)
I 'SAMESITE D Q ;
. S ZMSG="Wrong Rec Site ('"_SITENUM_"' vs. '"_SITE_"') /"_CDEBTID_"/"_CBILL_"/"_RID_RTYP
. D RECERR(.ERRCNT,"WRONG REC SITE",ZMSG,RECN,.RECERR)
S CACT=$E(REC,4),CFAST=$E(REC,5,6),CALC=$E(REC,7,14),CSTATN=$E(REC,15,19)
S CDEBTOR=$E(REC,50,64)
D CHKBD ; check for valid Bill/Debtor
S (CORIDG,CREFBAL)=""
Q ;GETPC1
;
GETPCS2 Q:CERRS(RTYP)=NULLERR
S CDEBTID=$E(REC,21,50)
S SITENUM=$E(CDEBTID,1,3)
S SAMESITE=$S(SITENUM=SITE:1,1:0)
I 'SAMESITE D Q ;
. S ZMSG="Wrong RecSite ('"_SITENUM_"' vs. '"_SITE_"') /"_CDEBTID_"/"_CBILL_"/"_RID_RTYP
. D RECERR(.ERRCNT,"WRONG REC SITE",ZMSG,RECN,.RECERR)
S CACT=$E(REC,4),CFAST=$E(REC,5,6),CALC=$E(REC,7,14),CSTATN=$E(REC,15,19)
S CDEBTOR=$E(REC,51,65)
D CHKBD ; check for valid Bill/Debtor
S (CORIDG,CREFBAL)=""
Q ;GETPC2
;
CHKBD ; checks for valid Bill/Debtor
S RECERR=""
S CBILL=$E(CDEBTID,1,3)_"-"_$E(CDEBTID,4,10),CDEBTIEN=+$E(CDEBTID,11,30)
I '$D(^PRCA(430,"B",CBILL,CDEBTIEN)) D ;
. S ZMSG="Bill IEN: "_CDEBTIEN_"/"_CBILL_"/"_RID_RTYP
. D RECERR(.ERRCNT,"NO BILL/DEBTOR ",ZMSG,RECN,.RECERR)
Q
;
RECERR(ERRCNT,ETYP,ERRDATA,RECN,RECERR) ; log TRANSMITTED FORMAT err
S (ERRCNT,^XTMP(NMSPC,$J,"ERR",0))=$G(^XTMP(NMSPC,$J,"ERR",0))+1
S ^XTMP(NMSPC,$J,"ERR",ERRCNT)=RECN_U_ERRDATA
S RECERR=1
Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSJS0 11295 printed Sep 23, 2025@19:24:52 Page 2
RCTCSJS0 ;ALBANY/RGB - CROSS-SERVICING REJECTS SERVER;02/19/14 3:21 PM
V ;;4.5;Accounts Receivable;**343**;Mar 20, 1995;Build 59
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 ;Program to process CS REJECT server messages from AITC
+3 ;
+4 ;===================================================================
+5 ;
SERVER ; entry from outside
+1 DO INIT1
+2 if '$LENGTH(XMZ1)
SET XMZ1=$SELECT($LENGTH(XMZ2):XMZ2,1:" ")
+3 if '$LENGTH(XMZ2)
SET XMZ2=$SELECT($LENGTH(XMZ1):XMZ1,1:" ")
+4 IF '$GET(XMZ1)!'$GET(XMZ2)
Begin DoDot:1
+5 DO RECERR(.ERRCNT,"Inv MM MSG","Invalid MM Msg# '"_$GET(XMZ1)_"'"_$SELECT(XMZ2'=XMZ1:" to '"_XMZ2_"'",1:""),0,.RECERR)
End DoDot:1
GOTO END
+6 IF '$DATA(^XMB(3.9,XMZ1))!'$DATA(^XMB(3.9,XMZ2))
Begin DoDot:1
+7 DO RECERR(.ERRCNT,"Inv MM MSG","Invalid MM Msg# '"_$GET(XMZ1)_"'"_$SELECT(XMZ2'=XMZ1:" to '"_XMZ2_"'",1:""),0,.RECERR)
End DoDot:1
GOTO END
+8 ;
+9 KILL LIST
FOR XMZ=XMZ1:1:XMZ2
SET LIST(XMZ)=""
+10 IF '$DATA(LIST)
DO RECERR(.ERRCNT,"BAD QUEUE","No Valid MM Msgs are for REJECTS Queues for MM Msg: "_XMZ,0,.RECERR)
GOTO END
+11 ;
FOR XMZ=XMZ1:1:XMZ2
IF $DATA(LIST(XMZ))
Begin DoDot:1
+12 KILL ^XTMP(NMSPC,$JOB,"BILL")
+13 KILL ^XTMP(NMSPC,$JOB,"REC")
+14 ; Queue Name
SET QNAM=$GET(^XMB(3.9,XMZ,2,1,0))
+15 ;
IF $DATA(^XMB(3.9,XMZ))
Begin DoDot:2
+16 SET BATFDT=$GET(^XMB(3.9,XMZ,.6))
+17 ; last record# of data
SET LSTREC=$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,3)
+18 ; #records expected from file
SET XNRECS=$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,4)
+19 ; AITC Header record
SET HDR=$GET(^XMB(3.9,XMZ,2,2,0))
+20 ; AITC Batch Control ID
SET BCIDA=$EXTRACT(HDR,2,9)
+21 ;
IF 'XNRECS!'$LENGTH(HDR)
Begin DoDot:3
+22 DO RECERR(.ERRCNT,"NO RECS/HDR","No Records Found: '"_XNRECS_"'",0,.RECERR)
End DoDot:3
QUIT
+23 DO START
End DoDot:2
End DoDot:1
END ;
+1 ;
IF '$DATA(^XTMP(NMSPC,$JOB,"BULTN"))
Begin DoDot:1
+2 SET BLTNCNT=$GET(BLTNCNT)+1
+3 SET ^XTMP(NMSPC,$JOB,"BULTN",BLTNCNT)=" "
+4 SET BLTNCNT=$GET(BLTNCNT)+1
+5 SET BLTNREC="NOTE: NO UNPROCESSABLE/REJECT RECORDS FOUND NEEDING TO BE PROCESSED"
+6 SET ^XTMP(NMSPC,$JOB,"BULTN",BLTNCNT)=BLTNREC
End DoDot:1
+7 DO SENDBUL^RCTCSJS1
+8 IF $DATA(^XTMP(NMSPC,$JOB,"ERR"))
DO SENDERR^RCTCSJS1
+9 DO CLEANUP^RCTCSJS1
+10 ; ENTER
QUIT
+11 ;
INIT1 ; initialize first time
+1 SET NMSPC="RCTCSJS"
+2 SET CSRCS=""
+3 SET XMZ1=$PIECE($GET(XMZ),"-")
+4 SET XMZ2=$PIECE($GET(XMZ),"-",2)
+5 KILL ^XTMP(NMSPC,$JOB)
+6 KILL TOTAMT,ARTXNID
+7 SET U="^"
+8 ; STATUS logging count
SET STATCNT=0
+9 DO NOW^%DTC
+10 SET (X1,RUNDT)=X
SET RUNDTTM=%
+11 SET X2=30
DO C^%DTC
+12 SET ^XTMP(NMSPC,$JOB,0)=X_U_RUNDT_U_"CS REJECT FILE PROCESSING/"_DUZ
+13 ; ERROR logging count
SET ERRCNT=0
+14 ; for no error codes
SET NULLERR=""
SET $PIECE(NULLERR," ",19)=""
+15 SET BLNKS=""
SET $PIECE(BLNKS," ",25)=""
+16 SET BLTNCNT=0
+17 SET SITE=$$SITE^RCMSITE()
+18 ; INIT1
QUIT
+19 ;
INIT2 ; subsequent inits
+1 ; "C" records count
SET CRCNT=0
+2 ; Total Amount of Referred Balance
SET TOTAMT=0
+3 ; new variables
NEW I
+4 ;
+5 ; last record# of data
SET LSTREC=$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,3)
+6 ; #records expected from file
SET XNRECS=$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,4)
+7 ; AITC Header record
SET HDR=$GET(^XMB(3.9,XMZ,2,2,0))
+8 ; AITC Batch Control ID
SET BCIDA=$EXTRACT(HDR,2,9)
+9 ;
IF 'XNRECS!'$LENGTH(HDR)
Begin DoDot:1
+10 DO RECERR(.ERRCNT,"NO RECS/HDR","No Records Found: '"_XNRECS_"'",0,.RECERR)
End DoDot:1
QUIT
+11 ; INIT2
QUIT
+12 ;
START ; start of process
+1 DO INIT2
+2 ; moves MM data from ^XMB(3.9,... to ^XTMP
DO XMB2XTMP
+3 ; sorts recs from ^XTMP into by Debtor, by BILL
DO SRTXTMP
+4 ; flag to determine if data is error free (or not)
SET STOPSET=""
+5 ; logs MailMan record COUNT error
IF RECNS'=XNRECS
Begin DoDot:1
+6 SET ZMSG="Expected MM RECS: '"_XNRECS_"' not same as # RECS FOUND: '"_RECNS_"'"
+7 DO RECERR(.ERRCNT,"RECNUMS",ZMSG,RECNS,.RECERR)
+8 SET STOPSET=1
End DoDot:1
TOT ;
+1 ; logs record Total Amt error
IF $TRANSLATE(TOTAMT,"-+","")'=(+ZTOTA*.01)
Begin DoDot:1
+2 SET X=TOTAMT
SET X2="2$"
SET X3=4
DO COMMA^%DTC
SET TOTAMOUT=$TRANSLATE(X," ","")
+3 SET X=ZTOTA*.01
SET X2="2$"
SET X3=4
DO COMMA^%DTC
SET ZTOTAOUT=$TRANSLATE(X," ","")
+4 SET ZMSG="Expected $Amt: '"_ZTOTAOUT_"' = ACCUMULATED AMT found: '"_TOTAMOUT_"'"
+5 DO RECERR(.ERRCNT,"TOTAL $ AMT",ZMSG,RECNS,.RECERR)
+6 SET STOPSET=STOPSET_2
End DoDot:1
+7 ; logs record COUNT error
IF CRCNT'=+$GET(ZRCNT)
Begin DoDot:1
+8 SET ZMSG="Z record RECS: '"_$GET(ZRCNT)_"' not same as # RECS FOUND: '"_CRCNT_"'"
+9 DO RECERR(.ERRCNT,"Z-REC-CNTS",ZMSG,RECNS,.RECERR)
+10 SET STOPSET=STOPSET_3
End DoDot:1
+11 ; whole file error detected, DO NOT PROCESS REJECTS
IF STOPSET
SET STOPMSG=""
Begin DoDot:1
+12 ;
FOR I=1:1:3
IF STOPSET[I
Begin DoDot:2
+13 IF I[1
SET STOPMSG="(#MM RECS("_XNRECS_") not same as #Recs found("_RECNS_")"
+14 IF I[2
SET STOPMSG="(ZTOTAMT("_(+$GET(ZTOTA)*.01)_") = Amt found("_TOTAMT*100_")"
+15 IF I[3
SET STOPMSG="(#Z RECCNT("_$GET(ZRCNT)_") not = #C Recs found("_CRCNT_")"
+16 SET ZMSG="BILL Records NOT Updated: "_STOPMSG
+17 DO RECERR(.ERRCNT,"FILE ERR",ZMSG,RECNS,.RECERR)
End DoDot:2
End DoDot:1
QUIT
+18 ; logs NO VALID BILLS found error
IF '$DATA(^XTMP(NMSPC,$JOB,"BILL"))
Begin DoDot:1
+19 SET ZMSG="Found NO REJECT Bill Errors"
+20 DO RECERR(.ERRCNT,"NO BILLS",ZMSG,0,.RECERR)
End DoDot:1
QUIT
+21 DO SETREJS^RCTCSJS
+22 ; START
QUIT
+23 ;
XMB2XTMP ;copies ^XMB(3.9,XMZ) to ^XTMP
+1 MERGE ^XTMP(NMSPC,$JOB,"READ",BCIDA)=^XMB(3.9,XMZ,2)
+2 ; XMB2XTMP
QUIT
+3 ;
SRTXTMP ;sorts ^XTMP(...,"READ" recs into ^XTMP(..."BILL" which is sorted by Debtor ID, by BILL
+1 ;
FOR RECN=2:2
if '$DATA(^XTMP(NMSPC,$JOB,"READ",BCIDA,RECN))
QUIT
Begin DoDot:1
+2 SET NOTPROC=""
+3 KILL CERRS
+4 SET RECERR=0
+5 SET REC1=^XTMP(NMSPC,$JOB,"READ",BCIDA,RECN,0)
+6 SET REC2=^XTMP(NMSPC,$JOB,"READ",BCIDA,RECN+1,0)
+7 ; eliminate record delimiters
SET REC=$PIECE(REC1,"^")_$PIECE(REC2,"~")
+8 if $EXTRACT(REC,1,4)="NNNN"
QUIT
+9 ; (H,C,Z)
SET RID=$EXTRACT(REC)
+10 ; eliminate spaces
SET RTYP=$TRANSLATE($EXTRACT(REC,2,3)," ","")
+11 ; logs RTYP error
IF RID="C"
IF ",1,2,2A,2B,2C,2D,2E,3,4,5A,5B,6,"'[(","_RTYP_",")
Begin DoDot:2
+12 SET CBILL=$EXTRACT(REC,20,29)
+13 SET ZMSG="Invalid Record TYPE Received: '"_RTYP_"' from Record: "_CBILL_", record# "_RECN
+14 DO RECERR(.ERRCNT,"INV REC TYPE",ZMSG,RECN,.RECERR)
End DoDot:2
QUIT
+15 ; (A,B,D,L,U,V)
SET RACTN=$EXTRACT(REC,4)
+16 ; logs record LEN error
IF $LENGTH(REC)'=471
Begin DoDot:2
+17 DO RECERR(.ERRCNT,"RECLEN","Record Length Error: "_$LENGTH(REC),RECN,.RECERR)
End DoDot:2
QUIT
+18 DO @RID
+19 ; quit, process err detected and logged via RECERR
if RECERR
QUIT
+20 ; ignore, no errors in this record
if $GET(CERRS(RTYP))=NULLERR!'$DATA(CERRS(RTYP))
QUIT
+21 ;
IF CERRS(RTYP)["9A"
SET REFBATCH=$EXTRACT(CERRS(RTYP),11,18)
Begin DoDot:2
+22 SET ZMSG="Invalid Referral Batch: '"_REFBATCH_"' from Message: '"_XMZ_"'"
+23 DO RECERR(.ERRCNT,"INV REF BATCH",ZMSG,RECN,.RECERR)
+24 SET ERRSFND("9A",REFBATCH,XMZ)=""
End DoDot:2
+25 ;
IF '$GET(SAMESITE)
Begin DoDot:2
+26 SET ZMSG="Expecting: '"_SITE_"', Found: '"_SITENUM_"'/"_CBILL_"/"_RID_RTYP
+27 DO RECERR(.ERRCNT,"WRONG REC SITE",ZMSG,RECN,.RECERR)
End DoDot:2
+28 ; ignore, this record belongs to a different site
if '$GET(SAMESITE)
QUIT
+29 ; Q:$G(NOTPROC) ; last Z record shows first THRU last batches were not all completely satisfied
+30 ;
+31 IF RID="C"
DO LOGREJS
End DoDot:1
+32 SET RECNS=RECN-1
+33 ; SRTXTMP
QUIT
+34 ;
C SET CRCNT=CRCNT+1
+1 SET CERRS(RTYP)=$EXTRACT(REC,452,469)
+2 ;
FOR PC=1:2
SET CHKEC=$EXTRACT(CERRS(RTYP),PC,PC+1)
if CHKEC=""
QUIT
if CHKEC=" "
QUIT
IF '$DATA(^RC(348.5,"B",CHKEC))
Begin DoDot:1
+3 SET ZMSG="Invalid Error Code: '"_CHKEC_"' in Batch: "_BCIDA_"/"_RID_RTYP
+4 SET ERR=1
DO RECERR(.ERRCNT,"INV ERR CODE",ZMSG,RECN,.RECERR)
End DoDot:1
+5 SET CSRC=$EXTRACT(REC,470)
SET CSRC=$SELECT(CSRC=" ":"T",1:CSRC)
+6 IF CSRCS'[CSRC
SET CSRCS=CSRCS_CSRC
+7 SET LBL="L"_RTYP
+8 ; perform record type parsing of data
DO @LBL
+9 ; C
QUIT
H ; Header record
+1 SET BCIDA=$EXTRACT(REC,2,9)
+2 SET HREC=REC
+3 SET HFAST=$EXTRACT(REC,24,25)
SET HALC=$EXTRACT(REC,26,33)
SET HERRS=$EXTRACT(REC,452,469)
SET HSRC=$EXTRACT(REC,470,471)
+4 ; (note: H4DATE is Y_DOY)
SET H4DATE=$EXTRACT(BCIDA,1,4)
SET HSEQ=$EXTRACT(BCIDA,5,9)
+5 DO DOY2EXT(H4DATE,.HDATE)
+6 ;
IF HDATE'?7N
SET ERR=1
DO RECERR(.ERRCNT,"INV DATE","Invalid Date: '"_HDATE_"' /"_RID_RTYP,RECN,.RECERR)
QUIT
+7 IF HERRS'=NULLERR
SET FILERR=$EXTRACT(HERRS,1,10)
SET BCIDV=$EXTRACT(HERRS,11,18)
+8 ; H
QUIT
Z ; Trailer record
+1 SET ZREC=REC
+2 SET ZRCNT=$EXTRACT(REC,2,9)
SET ZTOTA=$EXTRACT(REC,10,23)
+3 SET Z4DOY=$EXTRACT(REC,24,27)
+4 SET ZSEQ=$EXTRACT(REC,28,31)
+5 SET ZFAST=$EXTRACT(REC,46,47)
SET ZALC=$EXTRACT(REC,48,55)
+6 SET ZERRS=$SELECT($EXTRACT(REC,452)'=" ":$EXTRACT(REC,452,469),1:NULLERR)
+7 SET ZBAT1=$EXTRACT(REC,459,462)
SET ZBAT2=$EXTRACT(REC,463,466)
+8 SET ZSRC=$EXTRACT(REC,470,471)
+9 DO DOY2EXT(Z4DOY,.ZDATE)
+10 ; Z
QUIT
DOY2EXT(YDOY,ZDATE) ; gets Date from DOY;
+1 NEW X
+2 SET ZLYR=$EXTRACT(YDOY)
SET ZDOY=$EXTRACT(YDOY,2,4)
+3 SET %H=$HOROLOG
DO YX^%DTC
+4 SET X1=$SELECT($EXTRACT(X,3)=ZLYR:$EXTRACT(X,1,3)-1,$EXTRACT(X,3)<ZLYR:$EXTRACT(X,1,2)_ZLYR-11,$EXTRACT(X,3)>ZLYR:$EXTRACT(X,1,2)_ZLYR-1)_"1231"
+5 SET X2=ZDOY
DO C^%DTC
+6 SET NX=X
+7 ; error if DOY >365 and not a Leap Year
SET ZDATE=$SELECT(ZDOY>365&($EXTRACT(X,4,7)'="1231"):-1,1:NX)
+8 ; DOY2EXT
QUIT
+9 ;
L1 ; Debt Record
+1 SET CORIGD=$EXTRACT(REC,77,90)*.01
SET CREFBAL=$TRANSLATE($EXTRACT(REC,91,104),"-","0")*.01
+2 SET TOTAMT=$GET(TOTAMT)+CREFBAL
+3 DO GETPCS1
+4 ; L1
QUIT
L2 ;; Debtor Record
+1 SET CDEBTIN=$EXTRACT(REC,65,73)
SET CDEBNAML=$EXTRACT(REC,77,111)
SET CDEBNAMF=$EXTRACT(REC,112,146)
+2 SET CDEBNAMM=$EXTRACT(REC,147,181)
+3 DO GETPCS1
+4 ;L2
QUIT
L2A ;; Individual Debtor Record
+1 SET CDEBSEX=$EXTRACT(REC,68)
SET CDOB=$EXTRACT(REC,69,76)
+2 DO GETPCS1
+3 ;L2A
QUIT
L2B ; Business Debtor Record
+1 DO GETPCS1
+2 ; L2B
QUIT
L2C ; Debtor Contact Information
+1 SET CDEBTIN=$EXTRACT(REC,65,73)
+2 DO GETPCS1
+3 ; L2C
QUIT
L2D ; Debtor Record (Property Information)
+1 DO GETPCS1
+2 ; L2D
QUIT
L2E ; Debtor Record (Employment Information for Individual Debtor)
+1 DO GETPCS1
+2 ; L2E
QUIT
L3 ; Case Record
+1 DO GETPCS1
+2 ; L3
QUIT
L4 ; Alias Name
+1 SET CDEBTIN=$EXTRACT(REC,65,73)
+2 DO GETPCS1
+3 ; L4
QUIT
L5A ; Creditor Agency Financial Transactions (Collections)
+1 SET CTRAMT=$EXTRACT(REC,117,130)*.01
SET CORIGPMT=$EXTRACT(REC,117,130)*.01
+2 SET TOTAMT=+$GET(TOTAMT)+($TRANSLATE($EXTRACT(REC,117,130),"-","0")*.01)
+3 DO GETPCS2
+4 ; L5A
QUIT
L5B ; Creditor Agency Financial Transactions (Adjustments)
+1 SET CSPAMT=$EXTRACT(REC,117,130)*.01
SET CSTAMT=$EXTRACT(REC,173,186)*.01
+2 SET CSTADJ=$EXTRACT(REC,211,224)*.01
+3 SET TOTAMT=+$GET(TOTAMT)+($TRANSLATE($EXTRACT(REC,173,186),"-","0")*.01)
+4 DO GETPCS2
+5 SET ARTXNID=$EXTRACT(REC,93,107)
SET ARTXNID(CDEBTIEN)=+ARTXNID_U_CBILL_U_RECN
+6 ; L5B
QUIT
L6 ; Payment Bypass/Offset
+1 SET CDEBTIN=$EXTRACT(REC,65,73)
+2 DO GETPCS1
+3 ; L6
QUIT
+4 ;
LOGREJS ; compiles the varied reject errors by BILL
+1 KILL Z
+2 SET CERRS=$PIECE($GET(^XTMP(NMSPC,$JOB,"BILL",CDEBTIEN,CBILL,HDATE,CSRC,RTYP,RACTN)),U)
+3 ;
FOR I=2:2:18
SET ERR=$EXTRACT(CERRS(RTYP),I-1,I)
if ERR=" "
QUIT
Begin DoDot:1
+4 ;
IF '$DATA(^RC(348.5,"B",ERR))
Begin DoDot:2
+5 SET ZMSG="Unknown Error Code: '"_ERR_"', FOUND IN: "_CBILL_"/"_RID_RTYP
+6 DO RECERR(.ERRCNT,"UNK ERR CD",ZMSG,RECN,.RECERR)
End DoDot:2
QUIT
+7 ; captures new errs
if CERRS'[ERR
SET CERRS=CERRS_ERR_","
End DoDot:1
+8 IF $LENGTH(CERRS)
SET ^XTMP(NMSPC,$JOB,"BILL",CDEBTIEN,CBILL,HDATE,CSRC,RTYP,RACTN)=CERRS_U_$GET(ARTXNID(CDEBTIEN,CBILL))
+9 ; LOGREJS
QUIT
+10 ;
GETPCS1 ;
+1 if CERRS(RTYP)=NULLERR
QUIT
+2 SET CDEBTID=$EXTRACT(REC,20,49)
+3 SET SITENUM=$EXTRACT(CDEBTID,1,3)
+4 SET SAMESITE=$SELECT(SITENUM=SITE:1,1:0)
+5 ;
IF 'SAMESITE
Begin DoDot:1
+6 SET ZMSG="Wrong Rec Site ('"_SITENUM_"' vs. '"_SITE_"') /"_CDEBTID_"/"_CBILL_"/"_RID_RTYP
+7 DO RECERR(.ERRCNT,"WRONG REC SITE",ZMSG,RECN,.RECERR)
End DoDot:1
QUIT
+8 SET CACT=$EXTRACT(REC,4)
SET CFAST=$EXTRACT(REC,5,6)
SET CALC=$EXTRACT(REC,7,14)
SET CSTATN=$EXTRACT(REC,15,19)
+9 SET CDEBTOR=$EXTRACT(REC,50,64)
+10 ; check for valid Bill/Debtor
DO CHKBD
+11 SET (CORIDG,CREFBAL)=""
+12 ;GETPC1
QUIT
+13 ;
GETPCS2 if CERRS(RTYP)=NULLERR
QUIT
+1 SET CDEBTID=$EXTRACT(REC,21,50)
+2 SET SITENUM=$EXTRACT(CDEBTID,1,3)
+3 SET SAMESITE=$SELECT(SITENUM=SITE:1,1:0)
+4 ;
IF 'SAMESITE
Begin DoDot:1
+5 SET ZMSG="Wrong RecSite ('"_SITENUM_"' vs. '"_SITE_"') /"_CDEBTID_"/"_CBILL_"/"_RID_RTYP
+6 DO RECERR(.ERRCNT,"WRONG REC SITE",ZMSG,RECN,.RECERR)
End DoDot:1
QUIT
+7 SET CACT=$EXTRACT(REC,4)
SET CFAST=$EXTRACT(REC,5,6)
SET CALC=$EXTRACT(REC,7,14)
SET CSTATN=$EXTRACT(REC,15,19)
+8 SET CDEBTOR=$EXTRACT(REC,51,65)
+9 ; check for valid Bill/Debtor
DO CHKBD
+10 SET (CORIDG,CREFBAL)=""
+11 ;GETPC2
QUIT
+12 ;
CHKBD ; checks for valid Bill/Debtor
+1 SET RECERR=""
+2 SET CBILL=$EXTRACT(CDEBTID,1,3)_"-"_$EXTRACT(CDEBTID,4,10)
SET CDEBTIEN=+$EXTRACT(CDEBTID,11,30)
+3 ;
IF '$DATA(^PRCA(430,"B",CBILL,CDEBTIEN))
Begin DoDot:1
+4 SET ZMSG="Bill IEN: "_CDEBTIEN_"/"_CBILL_"/"_RID_RTYP
+5 DO RECERR(.ERRCNT,"NO BILL/DEBTOR ",ZMSG,RECN,.RECERR)
End DoDot:1
+6 QUIT
+7 ;
RECERR(ERRCNT,ETYP,ERRDATA,RECN,RECERR) ; log TRANSMITTED FORMAT err
+1 SET (ERRCNT,^XTMP(NMSPC,$JOB,"ERR",0))=$GET(^XTMP(NMSPC,$JOB,"ERR",0))+1
+2 SET ^XTMP(NMSPC,$JOB,"ERR",ERRCNT)=RECN_U_ERRDATA
+3 SET RECERR=1
+4 ;
QUIT
