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.
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