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

RCTCSPD.m

Go to the documentation of this file.
  1. RCTCSPD ;ALBANY/BDB-CROSS-SERVICING TRANSMISSION ;03/15/14 3:34 PM
  1. ;;4.5;Accounts Receivable;**301,327,315,336,338,351,350,343,417**;Mar 20, 1995;Build 30
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRCA*4.5*327 a. Add check to insure debtor exists to prevent
  1. ; undefined error and set in XTMP work global to
  1. ; be reported via 'TCSP' mailgroup.
  1. ; b. Added process controls throughout entire batch
  1. ; run and message to mail group 'TCSP' batch run
  1. ; is complete
  1. ; c. Move SETUP/FINISH to new routine RCTCSPD0
  1. ; due to SACC size constraints
  1. ; d. Move REC2C tag/code to RCTCSP7 to create space
  1. ; for debtor undefined logic
  1. ;
  1. ;PRCA*4.5*336 a. Shift code to handle 5B transactions ahead
  1. ; of other processing that could cause a 5B
  1. ; record to not be sent in batch run at tag
  1. ; $$UPDCHK(BILL), EXCEPT FOR RECALL CHECK.
  1. ; b. Ensure address calls to RCTCSP1 include flag
  1. ; to handle missing debtor node 1 correctly when
  1. ; building address for CS transactions
  1. ;
  1. ;PRCA*4.5*343 Added check to ensure bill is cross-service status,
  1. ; 'active' and bal>25 to send pending tx per node 19.
  1. ; Also, add check to ensure a re-established bill is
  1. ; NOT ever sent to Treasury.
  1. ;
  1. ;PRCA*4.5*417 Correct gender update issue caused by patch
  1. ; and incidents INC22249334 & INC21601588
  1. ;
  1. ENTER ;Entry point from nightly process PRCABJ
  1. N DEBTOR,RC151DT,PRIN,INT,ADMIN,TDEB,TFIL,RCDFN,CNTR,SITE,LN,FN,MN,SITE,F60DT,VADM,PHONE,QUIT,TOTAL,ZIPCODE,FULLNM,RCNT,REPAY,X1,X2,ERROR,ADDR,CAT,BILLDT,CURRTOT,SITECD
  1. N SEQ,CNTLID,PREPDT,X1,X2,X,DELDT,ACTDT,SITE40,PRCATX,PRCAREST,PRCAREFR
  1. D SETUP^RCTCSPD0
  1. S (DEBTOR,RCNT)=0,SEQ=0
  1. RSDEBTOR ;
  1. F S DEBTOR=$O(^PRCA(430,"C",DEBTOR)) Q:DEBTOR'?1N.N D
  1. .D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZBDEBTOR")=%_U_DEBTOR
  1. .N X,RCDFN,DEMCS,DOB,GNDR,DEBTOR0,DEBTOR1,DEBTOR3,DEBTOR7,DEBTOR8,BILL,RCTCSCW
  1. .I '$D(^RCD(340,DEBTOR,0)) S ^XTMP("RCTCSPD",$J,"ZZUNDEF",DEBTOR)="" Q
  1. .S RCTCSCW=0,DEBTOR0=^RCD(340,DEBTOR,0),DEBTOR1=$G(^(1)),DEBTOR3=$G(^(3)),DEBTOR7=$G(^(7))
  1. .S RCTCSCW=$$SSCHK^RCTCSP7(DEBTOR) Q:RCTCSCW=1 ;PRCA*4.5*417
  1. .S DEBTOR8=$O(^RCD(340,DEBTOR,8,"A"),-1) I DEBTOR8?1.N S DEBTOR8=$P($G(^RCD(340,DEBTOR,8,DEBTOR8,0)),U)
  1. .S RCDFN=+DEBTOR0
  1. .S DEMCS=$$DEM^RCTCSP1(RCDFN)
  1. .S DOB=$P(DEMCS,U,2)
  1. .S GNDR=$P(DEMCS,U) S:"MF"'[GNDR GNDR="U"
  1. .I $P(DEBTOR7,U,2) D:'+$P(DEBTOR7,U,3) ;send type 2 recall record
  1. ..N ACTION,B0,B15,BILL
  1. ..S ACTION="L"
  1. ..S B0="",B15="",BILL=0
  1. ..; The code below is designed to get ONLY one bill #. It is not a bug! As per VA SME contacts.
  1. ..F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N I $D(^PRCA(430,"TCSP",BILL)) I $P(^PRCA(430,BILL,15),U,7)'=1 S B0=$G(^PRCA(430,BILL,0)),B15=$G(^(15)) Q ;get one bill
  1. ..I BILL="" S BILL=0,$P(^RCD(340,DEBTOR,7),U,2,4)="^^",$P(DEBTOR7,U,2,4)="^^" Q ;cs debtor with no cs bill, clear the debtor recall flag, quit
  1. ..D REC2
  1. ..S $P(^RCD(340,DEBTOR,7),U,3)=DT
  1. ..S DEBTOR7=^RCD(340,DEBTOR,7),TAXID=$$TAXID^RCTCSP1(DEBTOR)
  1. ..S BILL=0 ;set debtor cross-serviced bills as recalled
  1. ..F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
  1. ...D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZCRBILL")=%_U_BILL
  1. ...I $D(^PRCA(430,"TCSP",BILL)) D Q
  1. ....S ^PRCA(430,BILL,15)=U_1_U_DT_U_$P(^PRCA(430,BILL,15),U,4,99)
  1. ....S $P(^PRCA(430,BILL,15),U,4)=$P(DEBTOR7,U,4) ;set the recall reason
  1. ....S $P(^PRCA(430,BILL,15),U,5)=$$GET1^DIQ(430,BILL,11) ;set the recall amount to the current amount
  1. ....K ^PRCA(430,"TCSP",BILL)
  1. ....D RCRSD^RCTCSPD4 ; set debtor recall non-financial transaction PRCA*4.5*315
  1. .S (BILL,TOTAL,REPAY)=0
  1. RSBILL .F S BILL=$O(^PRCA(430,"C",DEBTOR,BILL)) Q:BILL'?1N.N D
  1. ..I $G(ONEBILL)'="",BILL'=ONEBILL Q ; Test single bill ; PRCA*4.5*350
  1. ..D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZCTRACKER")=%_U_DEBTOR_U_BILL
  1. ..N B0,B4,B6,B7,B9,B12,B121,B14,B15,B16,B19,B20,ACTION,RR
  1. ..D TAXID^RCTCSP7(DEBTOR)
  1. ..S B0=$G(^PRCA(430,BILL,0)),B4=$G(^(4)),B6=$G(^(6)),B7=$G(^(7)),B9=$G(^(9)),B12=$G(^(12)),B121=$G(^(12.1)),B14=$G(^(14)),B15=$G(^(15)),B16=$G(^(16)),B19=$G(^(19)),B20=$G(^(20))
  1. ..S RR=$$RR^RCTCSPU(BILL) ;PRCA*4.5*350
  1. ..Q:($P(B6,U,21)\1)<ACTDT ;cs activation date cutoff
  1. ..I $D(^PRCA(430,"TCSP",BILL)),$$RCLLCHK^RCTCSP2(BILL) Q ;bill previously sent to TCSP
  1. ..I $$UPDCHK(BILL) Q
  1. ..Q:B4 ;repayment plan
  1. ..; Do we clear stop flag if RR TBD ; PRCA*4.5*350
  1. ..I +$P(B15,U,7),RR'=0 Q ;quit if bill is stopped
  1. ..Q:+$P(B14,U) ;bill referred to TOP
  1. ..Q:$P(DEBTOR1,"^",9)=1 ;quit if debtor address marked unknown
  1. ..Q:$E($P(DEMCS,U,3),1,5)="00000" ;quit if the ssn is not valid
  1. ..Q:DEBTOR8="S" ;quit if debtor is stopped PRCA*4.5*350
  1. ..Q:SITE40="S" ; quit if site is stopped PRCA*4.5*350
  1. ..I +$P(B12,U,1) Q ;check date bill sent to dmc
  1. ..Q:($P(B121,U,1)="N")!($P(B121,U,1)="P") ;dmc debt valid
  1. ..I $P(B6,U,4),($P(B6,U,5)="DOJ") Q
  1. ..Q:+$P(DEMCS,U,4) ;deceased patient
  1. ..Q:'$P(B0,U,2) ;no category
  1. ..S CAT=$P($G(^PRCA(430.2,$P(B0,U,2),0)),U,7)
  1. ..Q:'CAT
  1. ..;PRCA*4.5*338 - Use RFCHK^RCTOPD to determine if the Category can be referred
  1. ..; using the new date based algorithm.
  1. ..Q:'$$RFCHK^RCTOPD(CAT,"N",1.03,$P(B6,U,21))
  1. ..;end PRCA*4.5*338 ..;dpn checks
  1. ..I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,'$P(B20,U,4) D DUEPROC^RCTCSP3 Q ;check to send dpn file to aitc
  1. ..I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,$P(B20,U,4),'$P(B20,U,5) Q ;check for print letter date
  1. ..I $P(B20,U,3)=1,(10000+$G(^RC(342,1,"CS")))>DT,$P(B20,U,4),$P(B20,U,5) D I X<60 Q ;check for 60 day wait from print letter date
  1. ...N X1,X2
  1. ...S X1=DT,X2=$P(B20,U,5) D ^%DTC
  1. ...I X'<60 S $P(B20,U,6)=DT,^PRCA(430,BILL,20)=B20 ;set the bill referral date to the current date
  1. ..S BILLDT=$P(B6,U),PREPDT=$P(B0,U,10) ; PRCA*4.5*343 - change BILLDT from DATE ACCOUNT ACTIVATED (#60) to LETTER1(#61)
  1. ..I BILLDT>RC151DT Q ; PRCA*4.5*343 - Must be 151 days or more after LETTER1 date
  1. ..I ($P(B0,U,8)=16),('$P(B6,U,3)) D Q
  1. ...;no 3rd letter being sent
  1. ...N DNM
  1. ...S DNM=$$NAMEFF^RCTCSPRS(+DEBTOR0),^XTMP("RCTCSPD",$J,"THIRD",DNM,$P(B0,U))=""
  1. ..I $P(B0,U,8)=16 I $$ADDCHKND(BILL) Q
  1. ..I $P(B0,U,8)=16 I $$ADDCHKNB(BILL) Q
  1. ..Q
  1. .Q
  1. ;
  1. D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZDEND")=%
  1. D THIRD^RCTCSP2
  1. D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZETRANSMIT CS RECS")=%
  1. D COMPILE^RCTCSP2 ;compile cross-serviced records
  1. D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZFTRANSMIT DPN")=%
  1. D COMPILED^RCTCSP3 ;compile the aitc due process notification records
  1. D NOW^%DTC S ^XTMP("RCTCSPD",$J,"ZZGTRANSMIT FINISHED")=%,^XTMP("RCTCSPD",$J,"ZZHCOMPLETE")=%
  1. D FINISH^RCTCSPD0
  1. Q
  1. ;
  1. ADDCHKND(BILL) ;add a new bill referral, new debtor
  1. N TOTAL,ACTION,X
  1. S ACTION="A"
  1. I $D(^RCD(340,"TCSP",DEBTOR)) Q 0 ;check debtor previously referred
  1. I $P(DEBTOR7,U,2) Q 0 ;check debtor recall
  1. I $D(^PRCA(430,"TCSP",BILL)) Q 0 ;bill previously sent to TCSP
  1. S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
  1. I TOTAL<25 Q 1 ;no adds for bills less than $25
  1. I RR=0 D RRMARK^RCTCSPD0 ; PRCA*4.5*350
  1. I $P(B15,U,7) Q 0 ;check stop tcsp referral flag
  1. I $P(B15,U,2) Q 0 ;check tcsp bill recall flag
  1. D REC1,REC2,REC2A
  1. S $P(^PRCA(430,BILL,16),U,13)=DOB,B16=^(16)
  1. S $P(^PRCA(430,BILL,15),U,14)=GNDR,B15=^(15)
  1. D REC2C^RCTCSP7 ;PRCA*4.5*327
  1. S ADDRCS=$$ADDR^RCTCSP1(RCDFN,1) ;PRCA*4.5*336
  1. S $P(^PRCA(430,BILL,16),U,4,8)=$P(ADDRCS,U,1,5),$P(^(16),U,11)=$P(ADDRCS,U,6),$P(^(16),U,12)=$P(ADDRCS,U,7)
  1. S B16=^PRCA(430,BILL,16)
  1. D REC3^RCTCSP2
  1. S TAXID=$$TAXID^RCTCSP1(DEBTOR)
  1. S NAME=$$NAME^RCTCSP7(+DEBTOR0),NAME=$P(NAME,U)
  1. S $P(^PRCA(430,BILL,15),U,1)=DT,$P(^(16),U,1)=TAXID,$P(^(16),U,2)=NAME
  1. S X1=BILLDT,X2=+30 D C^%DTC S DELDT=X
  1. S $P(^PRCA(430,BILL,16),U,3)=DELDT,^PRCA(430,"TCSP",BILL)=""
  1. I $P($G(^PRCA(430,BILL,21)),U)="" S $P(^PRCA(430,BILL,21),U)=DT ;PRCA*4.5*336
  1. I '$D(^RCD(340,"TCSP",DEBTOR)) S $P(^RCD(340,DEBTOR,7),U,5)=DT,^RCD(340,"TCSP",DEBTOR)=""
  1. D:RR'=0 NEWDEBTR^RCTCSPD4 D:RR=0 RRSEND^RCTCSPD4 ; set CS new debtor new bill non-financial transaction PRCA*4.5*315
  1. Q 1
  1. ;
  1. ADDCHKNB(BILL) ;add a new bill referral, existing debtor
  1. N TOTAL,ACTION,TAXID,NAME,ADDRCS,X
  1. I '$D(^RCD(340,"TCSP",DEBTOR)) Q 0 ;check debtor previously referred
  1. I $D(^PRCA(430,"TCSP",BILL)) Q 0 ;bill previously sent to TCSP
  1. S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
  1. I TOTAL<25 Q 0 ;no adds for bills less than $25
  1. I RR=0 D RRMARK^RCTCSPD0 ; PRCA*4.5*350
  1. I $P(B15,U,2) Q 0 ;check tcsp bill recall flag
  1. I $P(B15,U,7) Q 0 ;check stop tcsp referral flag
  1. S ACTION="A" D REC1
  1. S ACTION="B" D REC2
  1. S ACTION="A" D REC3^RCTCSP2
  1. S TAXID=$$TAXID^RCTCSP1(DEBTOR)
  1. S NAME=$$NAME^RCTCSP7(+DEBTOR0),NAME=$P(NAME,U)
  1. S $P(^PRCA(430,BILL,15),U,1)=DT,$P(^(16),U,1)=TAXID,$P(^(16),U,2)=NAME,$P(^(16),U,3)=BILLDT,^PRCA(430,"TCSP",BILL)=""
  1. I $P($G(^PRCA(430,BILL,21)),U)="" S $P(^PRCA(430,BILL,21),U)=DT ;PRCA*4.5*336
  1. S ADDRCS=$$ADDR^RCTCSP1(RCDFN,1) ;PRCA*4.5*336
  1. S $P(^PRCA(430,BILL,16),U,4,8)=$P(ADDRCS,U,1,5),$P(^(16),U,11)=$P(ADDRCS,U,6),$P(^(16),U,12)=$P(ADDRCS,U,7)
  1. S $P(^PRCA(430,BILL,16),U,13)=DOB,B16=^(16)
  1. S $P(^PRCA(430,BILL,15),U,14)=GNDR,B15=^(15)
  1. I '$D(^RCD(340,"TCSP",DEBTOR)) S $P(^RCD(340,DEBTOR,7),U,5)=DT,^RCD(340,"TCSP",DEBTOR)=""
  1. D:RR'=0 DEBTOR^RCTCSPD4 D:RR=0 RRSEND^RCTCSPD4 ; set CS debtor new bill non-financial transaction PRCA*4.5*315, PRCA*4.5*350
  1. Q 1
  1. ;
  1. UPDCHK(BILL) ;update 5b or existing bill
  1. I $P(B15,U,2) Q 0 ;check tcsp bill recall flag
  1. N TOTAL,TAXID,OTAXID,NAME,ONAME,ADDR,OADDR,ADDRCS,COUNTRY,OCOUNTRY,OPHONE,ODOB,OGNDR,TRNIDX,TRN1,TRN8,TRNAMT,TRNNUM,TRNFLG,FIVBFLG,PRCATTYP
  1. ;5b check
  1. S FIVBFLG=0
  1. S TRNIDX=0 F S TRNIDX=$O(^PRCA(430,BILL,17,TRNIDX)) Q:+TRNIDX=0 D
  1. .S TRNNUM=$P($G(^PRCA(430,BILL,17,TRNIDX,0)),U,1),TRNFLG=$P($G(^PRCA(430,BILL,17,TRNIDX,0)),U,2)
  1. .Q:+TRNFLG=0
  1. .S TRN1=$G(^PRCA(433,TRNNUM,1)),TRNAMT=$P(TRN1,U,5) S:TRNAMT<0 TRNAMT=-TRNAMT
  1. .S TRN8=$G(^PRCA(433,TRNNUM,8))
  1. .S ACTION="U"
  1. .D REC5B^RCTCSP1
  1. .S $P(^PRCA(430,BILL,17,TRNIDX,0),U,2)=""
  1. .S FIVBFLG=1
  1. I $P(B15,U,7) Q 0 ;check stop tcsp referral flag ;PRCA*4.5*336
  1. S TOTAL=$P(B7,U)+$P(B7,U,2)+$P(B7,U,3)+$P(B7,U,4)+$P(B7,U,5)
  1. S (PRCAREST,PRCAREFR)=0
  1. I FIVBFLG,(TOTAL=0) S DR="151///@",DIE="^PRCA(430,",DA=BILL D ^DIE K DR,DIE,DA
  1. I $P($G(^PRCA(430,BILL,30)),U) D S:PRCAREFR PRCAREST=0 Q:PRCAREST 1 ;PRCA*4.5*343
  1. . S PRCATX=0 F S PRCATX=$O(^PRCA(433,"C",BILL,PRCATX)) Q:'PRCATX D
  1. . . S PRCATTYP=$P($G(^PRCA(433,PRCATX,1)),U,2)
  1. . . I PRCATTYP=43 S PRCAREST=1,PRCAREFR=0
  1. . . I PRCATTYP=86!(PRCATTYP=87) S PRCAREFR=1
  1. . . I PRCATTYP=88 S PRCAREFR=0
  1. I $D(^PRCA(430,"TCSP",BILL)),$P(B0,U,8)=16,TOTAL'<25 D ;PRCA*4.5*343
  1. . I $P(B19,U,1)=1 S ACTION="U" D REC1 S $P(B19,U,1)="" S $P(^PRCA(430,BILL,19),U,1)=""
  1. . I $P(B19,U,2)=1 S ACTION="U" D REC2 S $P(B19,U,2)="" S $P(^PRCA(430,BILL,19),U,2)=""
  1. . I $P(B19,U,3)=1 S ACTION="U" D REC2A S $P(B19,U,3)="" S $P(^PRCA(430,BILL,19),U,3)=""
  1. . I $P(B19,U,4)=1 S ACTION="A" D REC2C^RCTCSP7 S $P(B19,U,4)="" S $P(^PRCA(430,BILL,19),U,4)="" ;PRCA*4.5*327
  1. I FIVBFLG=1 Q 1 ;if 5b sent, then do not continue to referral check
  1. I '$D(^PRCA(430,"TCSP",BILL)) Q 0 ;if not cross-serviced, then continue referral check
  1. I '$D(^PRCA(430,BILL,16)) Q 0 ;quit null node 16 old address ;PRCA*4.5*343
  1. UP1 S NAME=$$NAME^RCTCSP7(+DEBTOR0),NAME=$P(NAME,U)
  1. S ONAME=$P(B16,U,2)
  1. I $P(B0,U,8)=16,$D(^PRCA(430,"TCSP",BILL)) I (NAME'=ONAME) D
  1. .S ACTION="U"
  1. .D REC2
  1. .S $P(^PRCA(430,BILL,16),U,2)=NAME,$P(^PRCA(430,BILL,19),U,2)="",$P(B19,U,2)=""
  1. S OADDR=$P(B16,U,4,8),OPHONE=$P(B16,U,11),OCOUNTRY=$P(B16,U,12)
  1. S ADDRCS=$$ADDR^RCTCSP1(RCDFN,1),PHONE=$P(ADDRCS,U,6),COUNTRY=$P(ADDRCS,U,7) ;PRCA*4.5*336
  1. I $P(DEBTOR1,"^",9)'=1 D ;if debtor address is not marked unknown, then check address
  1. .I $P(B0,U,8)=16,$D(^PRCA(430,"TCSP",BILL)) I ($P(ADDRCS,U,1,5)'=$P(OADDR,U,1,5))!(PHONE'=OPHONE)!(COUNTRY'=OCOUNTRY) D
  1. ..S ACTION="A" ;2c records have action code 'a'
  1. ..D REC2C^RCTCSP7
  1. ..S $P(B19,U,4)=""
  1. ..S $P(^PRCA(430,BILL,16),U,4,8)=$P(ADDRCS,U,1,5),$P(^PRCA(430,BILL,16),U,11)=PHONE,$P(^PRCA(430,BILL,16),U,12)=$P(ADDRCS,U,7)
  1. S B16=^PRCA(430,BILL,16)
  1. S ODOB=$P(^PRCA(430,BILL,16),U,13)
  1. S OGNDR=$P(^PRCA(430,BILL,15),U,14)
  1. I $P(B0,U,8)=16,$D(^PRCA(430,"TCSP",BILL)) I (DOB'=ODOB)!(GNDR'=OGNDR) D
  1. .S ACTION="U"
  1. .D REC2A
  1. .S $P(^PRCA(430,BILL,16),U,13)=DOB,B16=^PRCA(430,BILL,16)
  1. .S $P(^PRCA(430,BILL,15),U,14)=GNDR,B15=^PRCA(430,BILL,15)
  1. .Q
  1. Q 1 ;bill is cross-serviced so do not continue referral check
  1. ;
  1. REC1 ;record type 1
  1. N REC,KNUM,DEBTNR,AMTORIG,AMTPBAL,AMTIBAL,AMTABAL,AMTFBAL,AMTCBAL,AMTRFRRD,AMOUNT,DELDT,X,X1,X2,BILLDT,PREPDT
  1. S REC="C1 "_ACTION_"3636001200"_"DM1D "
  1. S KNUM=$P($P(B0,U,1),"-",2)
  1. S DEBTNR=$$AGDEBTID,REC=REC_DEBTNR_" " ; PRCA*4.5*350
  1. S REC=REC_"I A MSCC"
  1. S BILLDT=$P(B6,U,21),PREPDT=$P(B0,U,10)
  1. S REC=REC_$$DATE8(PREPDT)
  1. S X1=BILLDT,X2=+30 D C^%DTC S DELDT=X
  1. S REC=REC_$$DATE8(DELDT)
  1. S AMTPBAL=$P(B7,U,1) ;principle balance
  1. S AMTIBAL=$P(B7,U,2) ;interest balance
  1. S AMTABAL=$P(B7,U,3) ;administrative balance
  1. S AMTFBAL=$P(B7,U,4) ;marshal fee
  1. S AMTCBAL=$P(B7,U,5) ;court cost
  1. S AMTRFRRD=AMTPBAL+AMTIBAL+AMTABAL+AMTFBAL+AMTCBAL
  1. S AMTORIG=$P(B0,U,3)
  1. D ;
  1. .I ACTION="A" S REC=REC_$$AMOUNT(AMTRFRRD)_$$AMOUNT(AMTRFRRD) Q
  1. .I ACTION="L" S AMTRFRRD=0 S REC=REC_$$AMOUNT(AMTRFRRD)_$$AMOUNT(AMTRFRRD) Q
  1. .S REC=REC_$$BLANK(28)
  1. S REC=REC_" N "
  1. S AMOUNT=$$AMOUNT(AMTPBAL)_$$AMOUNT(AMTIBAL)_$$AMOUNT(AMTABAL)_$$AMOUNT(AMTFBAL+AMTCBAL)
  1. I ACTION="L" S AMOUNT=$$AMOUNT(0)_$$AMOUNT(0)_$$AMOUNT(0)_$$AMOUNT(0) ;by iai spec
  1. I ACTION="U" S AMOUNT=$$BLANK(56) ;by iai spec
  1. S REC=REC_AMOUNT
  1. I ACTION="L" D
  1. .S REC=REC_$$BLANK(252-$L(REC))
  1. .S RCD=$P(B15,U,4)
  1. .S REC=REC_$S(RCD="01":"01",RCD="07":"07",RCD="08":"08",RCD="15":"01",RCD="03":"01",RCD="05":"01",RCD="06":"01",1:"01")
  1. S REC=REC_$$BLANK(450-$L(REC))
  1. I ACTION="A" S $P(^PRCA(430,BILL,16),U,9)=AMTRFRRD,$P(^(16),U,10)=AMTRFRRD
  1. I ACTION="L" S $P(^PRCA(430,BILL,16),U,9)="",$P(^(16),U,10)=""
  1. S ^XTMP("RCTCSPD",$J,BILL,ACTION,1)=REC
  1. S ^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL)=$$TAXID^RCTCSP1(DEBTOR)_"^"_+$E(REC,91,102)_"."_$E(REC,103,104) ;sends mailman message of documents sent to user
  1. D CLR19(BILL,1)
  1. Q
  1. ;
  1. REC2 ;
  1. N REC,KNUM,DEBTNR,DEBTORNB,TAXID,NAME,RCD,HTAXID
  1. S REC="C2 "_ACTION_"3636001200"_"DM1D "
  1. S KNUM=$P($P(B0,U,1),"-",2),HTAXID=0
  1. S DEBTNR=$$AGDEBTID,REC=REC_DEBTNR ; PRCA*4.5*350
  1. S DEBTORNB=$E(SITE,1,3)_$TR($J(DEBTOR,12)," ",0)
  1. S REC=REC_DEBTORNB
  1. S TAXID=$$TAXID^RCTCSP1(DEBTOR) S:+$G(RCTCSSCH) HTAXID=TAXID,TAXID=$P(RCTCSSCH,U)
  1. S REC=REC_TAXID_"SSN"
  1. S NAME=$$NAME^RCTCSP7(+DEBTOR0),NAME=$P(NAME,U)
  1. I $G(RCTCSCW) S NAME=$E(RCTCSSCH,11,115)
  1. S REC=REC_NAME_$$BLANK(5)_"I"
  1. I ACTION="U",HTAXID S REC=REC_$$BLANK(35)_HTAXID
  1. I ACTION="L" D
  1. .S REC=REC_$$BLANK(232-$L(REC))
  1. .S RCD=$P(B15,U,4)
  1. .S REC=REC_$S(RCD="01":"12",RCD="07":"12",RCD="08":"12",RCD="15":"12",RCD="03":"03",RCD="05":"05",RCD="06":"06",1:"12")
  1. S REC=REC_$$BLANK(450-$L(REC))
  1. S ^XTMP("RCTCSPD",$J,BILL,ACTION,2)=REC
  1. S $P(^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL),U,1)=$$TAXID^RCTCSP1(DEBTOR)
  1. D CLR19(BILL,2)
  1. Q
  1. ;
  1. REC2A ;
  1. N REC,KNUM,DEBTNR,DEBTORNB
  1. S REC="C2A"_ACTION_"3636001200"_"DM1D "
  1. S KNUM=$P($P(B0,U,1),"-",2)
  1. S DEBTNR=$$AGDEBTID,REC=REC_DEBTNR ; PRCA*4.5*350
  1. S DEBTORNB=$E(SITE,1,3)_$TR($J(DEBTOR,12)," ",0)
  1. S REC=REC_DEBTORNB,REC=REC_$$BLANK(3),REC=REC_GNDR
  1. S REC=REC_$$DATE8($P(DEMCS,U,2)),REC=REC_$$BLANK(450-$L(REC))
  1. S ^XTMP("RCTCSPD",$J,BILL,ACTION,"2A")=REC
  1. S $P(^XTMP("RCTCSPD",$J,"BILL",ACTION,BILL),U,1)=$$TAXID^RCTCSP1(DEBTOR)
  1. D CLR19(BILL,3)
  1. Q
  1. AGDEBTID() ; Return Agency Debt ID accoring to new logic PRCA*4.5*350
  1. ; Input: SITE,KNUM,BILL,B15
  1. N TRAIL S TRAIL=$P($G(^PRCA(430,BILL,21)),U,2)
  1. I TRAIL="" Q $E(SITE,1,3)_$$LJZF(KNUM,7)_$TR($J(BILL,20)," ",0)
  1. Q $E(SITE,1,3)_$$LJZF(KNUM,7)_$TR($J(BILL,18)," ",0)_TRAIL
  1. ;
  1. DATE8(X) ;changes fileman date into 8 digit date yyyymmdd
  1. I +X S X=X+17000000
  1. S X=$E(X,1,8)
  1. Q X
  1. ;
  1. AMOUNT(X) ;changes amount to zero filled, right justified
  1. S:X<0 X=-X
  1. S X=$TR($J(X,0,2),".")
  1. S X=$E("000000000000",1,14-$L(X))_X
  1. Q X
  1. ;
  1. BLANK(X) ;returns 'x' blank spaces
  1. N BLANK
  1. S BLANK="",$P(BLANK," ",X+1)=""
  1. Q BLANK
  1. ;
  1. NOW() ;compiles current date,time
  1. N X,Y,%,%H
  1. S %H=$H D YX^%DTC
  1. Q Y
  1. ;
  1. RJZF(X,Y) ;right justify zero fill width Y
  1. S X=$E("000000000000",1,Y-$L(X))_X
  1. Q X
  1. ;
  1. LJSF(X,Y) ;x left justified, y space filled
  1. S X=$E(X,1,Y)
  1. S X=X_$$BLANK(Y-$L(X))
  1. Q X
  1. ;
  1. LJZF(X,Y) ;x left justified, y zero filled
  1. S X=X_"0000000000"
  1. S X=$E(X,1,Y)
  1. Q X
  1. ;
  1. RECALL(BILL) ; set the recall flag
  1. S $P(^PRCA(430,BILL,15),U,2)=1
  1. Q
  1. ;
  1. CLR19(BILL,X) ; clear the send flag
  1. S $P(^PRCA(430,BILL,19),U,X)=""
  1. Q
  1. ;