- 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 Feb 18, 2025@23:15:01 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