RCTC336P ;MNTVBB,RGB-TCSP date sent/address node cleanup + IAI error code file 348.5 updates ;12/14/17 3:34 PM
V ;;4.5;Accounts Receivable;**336**;Mar 20, 1995;Build 45
;;Per VA Directive 6402, this routine should not be modified.
Q
EN S U="^",(IEN,T,T1,T2)=0,DT=$$DT^XLFDT
K ^XTMP("RCTC336P")
S ^XTMP("RCTC336P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
D NOW^%DTC S ^XTMP("RCTC336P",$J,"ZZASTART")=%
1 ;SET MISSING FIELD DATE BILL REFERRED TO TCSP (#151) FOR TCSP BILL
F S IEN=$O(^PRCA(430,"TCSP",IEN)) Q:'IEN D
. S R15=$G(^PRCA(430,IEN,15)),R16=$G(^PRCA(430,IEN,16)),T=T+1
. I '$P(R15,U) D
. . S RCVERB="DATE> "_IEN_" "_$P(^PRCA(430,IEN,0),U)_" "_$P(^PRCA(430,IEN,0),U,9)_" "_R15
. . D BMES^XPDUTL(RCVERB)
. . S T1=T1+1
. . S ^XTMP("RCTC336P",$J,1,IEN)=R15
. . S DA=IEN,DIE="^PRCA(430,",DR="151////^S X=DT" D ^DIE K DA,DR,DIE
. . Q
. I R16="" D
. . S RCVERB="ADDR> "_IEN_" "_$P(^PRCA(430,IEN,0),U)_" "_$P(^PRCA(430,IEN,0),U,9)
. . D BMES^XPDUTL(RCVERB)
. . S T2=T2+1,RCDEBTOR=$P(^PRCA(430,IEN,0),U,9),RCBILLDA=IEN
. . D SET16 S RCVERB=^PRCA(430,RCBILLDA,16) D BMES^XPDUTL(RCVERB)
. . S ^XTMP("RCTC336P",$J,2,IEN,16)=^PRCA(430,RCBILLDA,16)
. Q
D NOW^%DTC S ^XTMP("RCTC336P",$J,"ZZBEND")=%
S ^XTMP("RCTC336P",$J,"ZZTOTALS")=T_U_T1_U_T2
S RCVERB="TOTAL 'TCSP': "_T
D BMES^XPDUTL(RCVERB)
S RCVERB="TOTAL NULL Date Sent TCSP: "_T1
D BMES^XPDUTL(RCVERB)
S RCVERB="TOTAL ADDRESS NODE 16 FIXED: "_T2
D BMES^XPDUTL(RCVERB)
K IEN,T,T1,T2,R
UPD3485 ;Update IAI error codes in file 348.5
S U="^",UPD=0,NUM=4
UPD1 S UPD=UPD+1 G:UPD>NUM UPD3485Q
S R=$P($T(ERRCDS+UPD),";",2),ERRCD=$P(R,U),UPDTYP=$P(R,U,2),FNACT=$P(R,U,3),RECTYPE=$P(R,U,4),ERRMSG=$P(R,U,5)
UEDIT ;edit record in file 348.5
I UPDTYP="E" D G UPD1
. S DA=$O(^RC(348.5,"B",ERRCD,0)) Q:'DA
. S DIE="^RC(348.5,",DR="1///^S X=FNACT;2///^S X=RECTYPE;3///^S X=ERRMSG"
. D ^DIE K DIE,DR,DA
UADD ;add record in file 348.5
S X=ERRCD,DLAYGO=348.5,DIC="^RC(348.5,",DIC(0)="LXZ" D ^DIC K DLAYGO,DIC
S DA=+Y,DIE="^RC(348.5,",DR="1///^S X=FNACT;2///^S X=RECTYPE;3///^S X=ERRMSG"
D ^DIE K DIE,DR,DA
G UPD1
UPD3485Q K UPD,NUM,R,UPDTYP,ERRCDID,FNACT,RECTYPE,ERRMSG Q
SET16 ;SET MISSING NODE 16 FOR TCSP BILL
N RCXX,RCYY,RCDEBTR0,DEBTOR0,DEBTOR1,RCDFN,RCDPN16,RCB6,RCB7,RCBILLDT,TAXID,RCNAME,DEBTOR,RCAMTRFD
S (RCDEBTR0,DEBTOR0)=$G(^RCD(340,RCDEBTOR,0)),DEBTOR1=$G(^RCD(340,RCDEBTOR,1)),RCDFN=+RCDEBTR0
Q:$P(RCDEBTR0,U)'["DPT"
S RCDPN16="",RCB6=$G(^PRCA(430,RCBILLDA,6)),RCB7=$G(^(7)),RCBILLDT=$P($P(RCB6,U,21),".")
S TAXID=$$TAXID^RCTCSPD(RCDEBTOR),RCNAME=$$NAME^RCTCSPD(+RCDEBTR0),RCNAME=$P(RCNAME,U)
S $P(RCDPN16,U)=TAXID,$P(RCDPN16,U,2)=RCNAME,$P(RCDPN16,U,3)=+RCBILLDT
S DEBTOR=RCDEBTOR,ADDRCS=$$ADDR^RCTCSP1(RCDFN,1),$P(RCDPN16,U,4,8)=$P(ADDRCS,U,1,5)
S $P(RCDPN16,U,12)=$S($P(ADDRCS,U,7)>2:$P(ADDRCS,U,7),+^PRCA(430,RCBILLDA,0)=436:2,1:1) S $P(RCDPN16,U,13)=$P($G(^DPT(RCDFN,0)),U,3)
S RCAMTRFD=0 F I=1:1:5 S RCAMTRFD=RCAMTRFD+$P(RCB7,U,I)
F I=9,10 S $P(RCDPN16,U,I)=RCAMTRFD
S (RCXX,RCYY)=$P(ADDRCS,U,6)
I RCXX'?10N D
. S RCYY="" F I=1:1:$L(RCXX) I $E(RCXX,I)?1N S RCYY=RCYY_$E(RCXX,I)
S $P(RCDPN16,U,11)=$E("000000000000",1,10-$L(RCYY))_RCYY
S ^PRCA(430,RCBILLDA,16)=RCDPN16
Q
ERRCDS ;file 348.5 error code adjustments
;53^E^Invalid Phone number^^Invalid phone number: ####
;9A^E^Batch Control ID is Invalid^Header Record^Batch Control ID is Invalid
;0C^A^Agency Debt ID^5A^Cannot post payment to a closed case
;0D^A^Undefined Processing Error-New Business Phase^5B^New Business Phase-Transaction could not be added
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTC336P 3600 printed Dec 13, 2024@01:48:37 Page 2
RCTC336P ;MNTVBB,RGB-TCSP date sent/address node cleanup + IAI error code file 348.5 updates ;12/14/17 3:34 PM
V ;;4.5;Accounts Receivable;**336**;Mar 20, 1995;Build 45
+1 ;;Per VA Directive 6402, this routine should not be modified.
+2 QUIT
EN SET U="^"
SET (IEN,T,T1,T2)=0
SET DT=$$DT^XLFDT
+1 KILL ^XTMP("RCTC336P")
+2 SET ^XTMP("RCTC336P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT
+3 DO NOW^%DTC
SET ^XTMP("RCTC336P",$JOB,"ZZASTART")=%
1 ;SET MISSING FIELD DATE BILL REFERRED TO TCSP (#151) FOR TCSP BILL
+1 FOR
SET IEN=$ORDER(^PRCA(430,"TCSP",IEN))
if 'IEN
QUIT
Begin DoDot:1
+2 SET R15=$GET(^PRCA(430,IEN,15))
SET R16=$GET(^PRCA(430,IEN,16))
SET T=T+1
+3 IF '$PIECE(R15,U)
Begin DoDot:2
+4 SET RCVERB="DATE> "_IEN_" "_$PIECE(^PRCA(430,IEN,0),U)_" "_$PIECE(^PRCA(430,IEN,0),U,9)_" "_R15
+5 DO BMES^XPDUTL(RCVERB)
+6 SET T1=T1+1
+7 SET ^XTMP("RCTC336P",$JOB,1,IEN)=R15
+8 SET DA=IEN
SET DIE="^PRCA(430,"
SET DR="151////^S X=DT"
DO ^DIE
KILL DA,DR,DIE
+9 QUIT
End DoDot:2
+10 IF R16=""
Begin DoDot:2
+11 SET RCVERB="ADDR> "_IEN_" "_$PIECE(^PRCA(430,IEN,0),U)_" "_$PIECE(^PRCA(430,IEN,0),U,9)
+12 DO BMES^XPDUTL(RCVERB)
+13 SET T2=T2+1
SET RCDEBTOR=$PIECE(^PRCA(430,IEN,0),U,9)
SET RCBILLDA=IEN
+14 DO SET16
SET RCVERB=^PRCA(430,RCBILLDA,16)
DO BMES^XPDUTL(RCVERB)
+15 SET ^XTMP("RCTC336P",$JOB,2,IEN,16)=^PRCA(430,RCBILLDA,16)
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO NOW^%DTC
SET ^XTMP("RCTC336P",$JOB,"ZZBEND")=%
+18 SET ^XTMP("RCTC336P",$JOB,"ZZTOTALS")=T_U_T1_U_T2
+19 SET RCVERB="TOTAL 'TCSP': "_T
+20 DO BMES^XPDUTL(RCVERB)
+21 SET RCVERB="TOTAL NULL Date Sent TCSP: "_T1
+22 DO BMES^XPDUTL(RCVERB)
+23 SET RCVERB="TOTAL ADDRESS NODE 16 FIXED: "_T2
+24 DO BMES^XPDUTL(RCVERB)
+25 KILL IEN,T,T1,T2,R
UPD3485 ;Update IAI error codes in file 348.5
+1 SET U="^"
SET UPD=0
SET NUM=4
UPD1 SET UPD=UPD+1
if UPD>NUM
GOTO UPD3485Q
+1 SET R=$PIECE($TEXT(ERRCDS+UPD),";",2)
SET ERRCD=$PIECE(R,U)
SET UPDTYP=$PIECE(R,U,2)
SET FNACT=$PIECE(R,U,3)
SET RECTYPE=$PIECE(R,U,4)
SET ERRMSG=$PIECE(R,U,5)
UEDIT ;edit record in file 348.5
+1 IF UPDTYP="E"
Begin DoDot:1
+2 SET DA=$ORDER(^RC(348.5,"B",ERRCD,0))
if 'DA
QUIT
+3 SET DIE="^RC(348.5,"
SET DR="1///^S X=FNACT;2///^S X=RECTYPE;3///^S X=ERRMSG"
+4 DO ^DIE
KILL DIE,DR,DA
End DoDot:1
GOTO UPD1
UADD ;add record in file 348.5
+1 SET X=ERRCD
SET DLAYGO=348.5
SET DIC="^RC(348.5,"
SET DIC(0)="LXZ"
DO ^DIC
KILL DLAYGO,DIC
+2 SET DA=+Y
SET DIE="^RC(348.5,"
SET DR="1///^S X=FNACT;2///^S X=RECTYPE;3///^S X=ERRMSG"
+3 DO ^DIE
KILL DIE,DR,DA
+4 GOTO UPD1
UPD3485Q KILL UPD,NUM,R,UPDTYP,ERRCDID,FNACT,RECTYPE,ERRMSG
QUIT
SET16 ;SET MISSING NODE 16 FOR TCSP BILL
+1 NEW RCXX,RCYY,RCDEBTR0,DEBTOR0,DEBTOR1,RCDFN,RCDPN16,RCB6,RCB7,RCBILLDT,TAXID,RCNAME,DEBTOR,RCAMTRFD
+2 SET (RCDEBTR0,DEBTOR0)=$GET(^RCD(340,RCDEBTOR,0))
SET DEBTOR1=$GET(^RCD(340,RCDEBTOR,1))
SET RCDFN=+RCDEBTR0
+3 if $PIECE(RCDEBTR0,U)'["DPT"
QUIT
+4 SET RCDPN16=""
SET RCB6=$GET(^PRCA(430,RCBILLDA,6))
SET RCB7=$GET(^(7))
SET RCBILLDT=$PIECE($PIECE(RCB6,U,21),".")
+5 SET TAXID=$$TAXID^RCTCSPD(RCDEBTOR)
SET RCNAME=$$NAME^RCTCSPD(+RCDEBTR0)
SET RCNAME=$PIECE(RCNAME,U)
+6 SET $PIECE(RCDPN16,U)=TAXID
SET $PIECE(RCDPN16,U,2)=RCNAME
SET $PIECE(RCDPN16,U,3)=+RCBILLDT
+7 SET DEBTOR=RCDEBTOR
SET ADDRCS=$$ADDR^RCTCSP1(RCDFN,1)
SET $PIECE(RCDPN16,U,4,8)=$PIECE(ADDRCS,U,1,5)
+8 SET $PIECE(RCDPN16,U,12)=$SELECT($PIECE(ADDRCS,U,7)>2:$PIECE(ADDRCS,U,7),+^PRCA(430,RCBILLDA,0)=436:2,1:1)
SET $PIECE(RCDPN16,U,13)=$PIECE($GET(^DPT(RCDFN,0)),U,3)
+9 SET RCAMTRFD=0
FOR I=1:1:5
SET RCAMTRFD=RCAMTRFD+$PIECE(RCB7,U,I)
+10 FOR I=9,10
SET $PIECE(RCDPN16,U,I)=RCAMTRFD
+11 SET (RCXX,RCYY)=$PIECE(ADDRCS,U,6)
+12 IF RCXX'?10N
Begin DoDot:1
+13 SET RCYY=""
FOR I=1:1:$LENGTH(RCXX)
IF $EXTRACT(RCXX,I)?1N
SET RCYY=RCYY_$EXTRACT(RCXX,I)
End DoDot:1
+14 SET $PIECE(RCDPN16,U,11)=$EXTRACT("000000000000",1,10-$LENGTH(RCYY))_RCYY
+15 SET ^PRCA(430,RCBILLDA,16)=RCDPN16
+16 QUIT
ERRCDS ;file 348.5 error code adjustments
+1 ;53^E^Invalid Phone number^^Invalid phone number: ####
+2 ;9A^E^Batch Control ID is Invalid^Header Record^Batch Control ID is Invalid
+3 ;0C^A^Agency Debt ID^5A^Cannot post payment to a closed case
+4 ;0D^A^Undefined Processing Error-New Business Phase^5B^New Business Phase-Transaction could not be added
