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

RCTC336P.m

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