RCDPUREC ;WISC/RFJ - receipt utilities ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**114,148,169,173,208,222,293,298,321,326,380,367,371,409**;Mar 20, 1995;Build 17
;Per VA Directive 6402, this routine should not be modified.
Q
;
ADDRECT(TRANDATE,RCDEPTDA,PAYTYPDA) ;EP Add a receipt
; Input: TRANDATE - Deposit Date in fileman format
; RCDEPTDA - IEN in AR DEPOSIT file (#344.1)
; PAYTYPDA - AR Event Type IEN (#341.1)
; Returns: 0 - No receipt added or receipt IEN otherwise
;
; If deposit or payment type is missing, do not add the receipt
I 'RCDEPTDA!('PAYTYPDA) Q 0
;
N DA,DATA,RCDPFLAG,RECEIPT,TYPE
;
; If a receipt has already been added for this transmission date
; and deposit number, do not add a new one
;PRCA*4.5*380 - Removed to allow for duplicate deposit number/date records
;S DA=0 F S DA=$O(^RCY(344,"AD",+RCDEPTDA,DA)) Q:'DA S DATA=$G(^RCY(344,DA,0)) I $P($P(DATA,"^",3),".")=TRANDATE,$P(DATA,"^",4)=PAYTYPDA S RCDPFLAG=1 Q
;I $G(RCDPFLAG) Q DA
;
Q $$BLDRCPT(TRANDATE,RCDEPTDA,PAYTYPDA)
;
BLDRCPT(TRANDATE,RCDEPTDA,PAYTYPDA,RCDUZ) ;EP Build a receipt with/without deposit
; LAYGO new entry to AR BATCH PAYMENT file (#344)
; Input: TRANDATE - Deposit Date in fileman format
; RCDEPTDA - IEN in AR DEPOSIT file (#344.1)
; PAYTYPDA - AR Event Type IEN (#341.1)
; RCDUZ - User IEN (#200)
; Returns: New IEN on success, else zero
;
N GOTONE,RECEIPT,TYPE
; ATTMPT - Count of attempts
; GOTONE - New receipt # flag
S GOTONE=0
;
; Build unique receipt number for date
S TYPE=$E($G(^RC(341.1,PAYTYPDA,0)),1) ;PRCA*4.5*409 '0' if PAYTYPDA=18 for OGC-EFT
I TYPE="" S TYPE="Z" ; ^RC(341.1,0) = AR EVENT TYPE
I TYPE="C",$G(RCDEPTDA)["ERACHK" S RCDEPTDA=+RCDEPTDA,TYPE="E" ; ERA plus paper check EDI Lockbox receipt
;
; Accounts Receivable Nightly Process Background Job [PRCA NIGHTLY PROCESS]
; -----
;
;lockbox receipt in the form of L980901A0, do not include century
F D Q:+GOTONE&$L(RECEIPT) ; Must be new and non-null
. ;
. ; Find a unique receipt #
. S RECEIPT=$$NEXT(TYPE_$E(TRANDATE,2,7)) ; Get last two digits from 00 to ZZ
. I RECEIPT="" Q
. I $D(^RCY(344,"B",RECEIPT)) Q ; AR BATCH PAYMENT file (#344), RECEIPT # field (#.01)
. I $D(^PRCA(433,"AF",RECEIPT)) Q ; AR TRANSACTION file (#433), RECEIPT # field (#13)
. S GOTONE=1
;
;
L +^RCY(344,"B",RECEIPT):DILOCKTM E Q 0 ;PRCA*4.5*298, if LOCK timeout return zero
;
; Add entry to AR BATCH PAYMENT file (#344)
N %,%DT,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,X,Y
S DIC="^RCY(344,",DIC(0)="L",DLAYGO=344
; .02 = opened by .03 = date opened = transmission dt
; .04 = type of payment .06 = deposit ticket
; .14 = status (set to 1:open)
S DIC("DR")=".02////"_$S($G(RCDUZ):RCDUZ,1:DUZ) ; PRCA*4.5*326 Use RCDUZ passed in
S DIC("DR")=DIC("DR")_";.03///"_TRANDATE_";.04////"_PAYTYPDA_$S(RCDEPTDA:";.06////"_RCDEPTDA,1:"")_";.14////1;"
S X=RECEIPT
D FILE^DICN
L -^RCY(344,"B",RECEIPT)
I Y>0 Q +Y ; Y set by DICN, return new IEN
Q 0 ; Entry not created
;
NEXT(RECEIPT) ; function, get next 2 chars. in sequence 00 to ZZ for receipt
;
; start with 00
I '$D(^RCY(344,"B",RECEIPT_"00")),'$D(^RCY(344,"B",RECEIPT_"00A")) Q RECEIPT_"00"
;
N DIGIT1,DIGIT2,LAST
; get the last one used and increment by 1
S LAST=$O(^RCY(344,"B",RECEIPT_"ZZ"),-1) ;example L2980901ZZ
S DIGIT1=$A($E(LAST,8)),DIGIT2=$A($E(LAST,9))
; increment the ascii value of last digit
S DIGIT2=DIGIT2+1
; ascii 48=0, 57=9, 65=A, 90=Z
I DIGIT2>57,DIGIT2<65 S DIGIT2=65 ;an A
; digit2 above a Z, set digit2 to a 0 and increment digit 1
I DIGIT2>90 S DIGIT2=48,DIGIT1=DIGIT1+1
I DIGIT1>57,DIGIT1<65 S DIGIT1=65 ;an A
; digit 1 is above a Z, reset and reuse the Z
I DIGIT1>90 S DIGIT1=90,DIGIT2=90
;
; If Receipt # already on file get another one
F Q:'$D(^RCY(344,"B",RECEIPT_$C(DIGIT1)_$C(DIGIT2))) D
. S RECEIPT=$E(RECEIPT,1)_$E(1000001+$E(RECEIPT,2,7),2,7)
;
Q RECEIPT_$C(DIGIT1)_$C(DIGIT2)
;
;
SELRECT(ADDNEW,RCDEPTDA) ; select a receipt
; if $g(addnew) allow adding a new receipt
; if $g(rcdeptda) allow selection of receipts for the deposit only
; if $g(addnew) and $g(rcdeptda) deposit number auto set for new receipt
; returns -1 for timeout or ^, 0 for no selection, or ien of receipt
N %,%Y,C,D0,DA,DG,DI,DIC,DIE,DIK,DLAYGO,DQ,DR,DTOUT,DUOUT
N RC1,RC2,RCDE,RCHMP,RCLB,RCPAYTYP,RCREFLUP,RCREQ,RCY,X,Y ;PRCA*4.5*409 Added RCPAYTYP
S RCPAYTYP=""
S DIC="^RCY(344,",DIC(0)="QEAM",DIC("A")="Select RECEIPT: "
S DIC("W")="D DICW^RCDPUREC"
; set screen to select receipts linked to deposit and to screen out
; selection of EDI Lockbox-type receipts unless an EFT is associated
; with the deposit and the receipt is not associated with an ERA
S RCDE=+$O(^RCY(344.3,"ARDEP",+$G(RCDEPTDA),0))
I $G(RCDEPTDA) D
. S DIC("S")="N Z S Z=$G(^(0)) I $S('$$EDILBEV^RCDPEU($P(Z,U,4)):'RCDE,1:RCDE&'$P(Z,U,18)),($P(Z,U,6)=""""!($P(Z,U,6)=RCDEPTDA))"
. S DIC("A")="Select RECEIPT (for deposit "_$P(^RCY(344.1,RCDEPTDA,0),"^")_"): "
; use special lookup on input
I '$G(RCDEPTDA) S RCREFLUP=1
; add new entries
S RC1="TYPE NOT VALID FOR THIS RECEIPT",RC2=">>AN EFT REFERENCE IS REQUIRED"
I $G(ADDNEW) D
. S DIC("A")="Select RECEIPT (or add a new one): "
. S DIC(0)="QEALM",DLAYGO=344
. S DIC("DR")="S RCREQ=0;.02////"_DUZ_";.03///NOW;.14////1;@4;.04"_$S(RCDE:"////"_$$LBEVENT^RCDPEU(),1:"")
. ; Next line use EFT picker utility instead of .17 in DR string - PRCA*4.5*326
. ; Do not delete DIC("W") from the DR string. It has a role in ^DIC flow if an EFT is not picked.
. ; PRCA*4.5*367 - If type is CHAMPVA, jump to setting receipt total then exit
. ; PRCA*4.5*409 Added RCPAYTYP=+X,
. S DIC("DR")=DIC("DR")_";S RCPAYTYP=+X,RCLB=$$EDILBEV^RCDPEU(RCPAYTYP),RCHMP=$$ISCHMPVA^RCDPUREC(+$G(X)) S:'RCLB Y=""@6"" S:RCHMP Y=""@9"";I $G(RCDEPTDA) S Y=$S('RCDE:""@8"",1:""@6"");W !,RC2 S RCREQ=1,DIC(""W"")="""""
. ; PRCA*4.5*409 Added ,RCPAYTYP
. S DIC("DR")=DIC("DR")_";D EFT344^RCDPEU2("" AR BATCH PAYMENT EFT RECORD: "",DA,RCPAYTYP);S Y=""@99"";@6;.06"_$S($G(RCDEPTDA):"////"_RCDEPTDA,1:"")_";S:'RCDE Y=""@99"";.17////"_+RCDE_";S Y=""@99"";@8;W *7,!,RC1 S Y=""@4"";@9;.22;@99"
. S DIC("DR")=DIC("DR")_";"
D ^DIC
S RCY=Y
I RCY<0,'$G(DUOUT),'$G(DTOUT) S RCY=0
I $P(RCY,U,3),$G(RCREQ) D
. I '$P($G(^RCY(344,+RCY,0)),U,17) D Q
.. W !,*7,"NO EFT REFERENCED - RECEIPT NOT ADDED"
.. S DA=+RCY,DIK="^RCY(344," D ^DIK
.. S RCY=0
. S DIE="^RCY(344.31,",DA=$P(^RCY(344,+RCY,0),U,17),DR=".08////2" D ^DIE
Q +RCY
;
;
DICW ; write identifier code for receipt lookup
N DATA
S DATA=$G(^RCY(344,Y,0)) I DATA="" Q
; opened by
W ?13,"by: ",$E($P($G(^VA(200,+$P(DATA,"^",2),0)),"^"),1,15)
; date opened
I '$P(DATA,"^",3) S $P(DATA,"^",3)="???????"
W ?35," on: ",$E($P(DATA,"^",3),4,5),"/",$E($P(DATA,"^",3),6,7),"/",$E($P(DATA,"^",3),2,3)
; type of payment
W ?50," ",$E($P($G(^RC(341.1,+$P(DATA,"^",4),0)),"^"),1,18)
; status
W ?70," ",$S($P(DATA,"^",14):"OPEN",1:"CLOSED")
Q
;
;
LOOKUP ; special lookup on receipts, called from ^dd(344,.01,7.5)
; if rcreflup flag not set, do not use special lookup
I '$D(RCREFLUP) Q
; user entered O.? for lookup on open receipts
I X["O."!(X["o.") S DIC("S")="I $P(^(0),U,14)" S X="?" Q
; user entered C.? for lookup on closed receipts
I X["C."!(X["c.") S DIC("S")="I '$P(^(0),U,14)" S X="?" Q
K DIC("S")
Q
;
; PRCA*4.5*298 - updated logic and comments in EDITREC
EDITREC(DA,DR) ; edit the receipt (DR = string of fields to ask) in AR BATCH PAYMENT file (#344)
; RCBPYMNT - AR BATCH PAYMENT entry before edit
N D,D0,DI,DIC,DIE,DQ,EFTKEY,RCBPYMNT,RCDA,RCDR1,RCDR2,RCDR3,RCNE,X,Y ; PRCA*4.5*371 Added RCNE
S (DIC,DIE)="^RCY(344,",RCDA=DA
S EFTKEY=$$EFTKEY() ; PRCA*4.5*321 - Check if user has key to unmatch EFTs
I $G(DR)="" N DR D
. S DR=".01;.04;"_$S($P($G(^RCY(344,RCDA,0)),U,17):"",1:"I $P($G(^RCY(344,DA,0)),U,17) S Y=""@1001"";.06;@1001;")_"D LBT^RCDPUREC(.Y);.18;@99"
;
I $G(DR)[".04;" D ; Add a check to DR string for type of payment edit
.D EDIT4^RCDPURE1(RCDA,DR,.RCDR1,.RCDR2,.RCDR3) ; get new DR strings in RCDR1,RCDR2,RCDR3
.S DR=$S($E(RCDR1,$L(RCDR1))'=";":RCDR1,1:$E(RCDR1,1,$L(RCDR1)-1)),DR(1,344,1)=RCDR2,DR(1,344,2)=RCDR3
;
M RCBPYMNT=^RCY(344,DA) ; save initial values
;
D ^DIE
;
; (#.04) TYPE OF PAYMENT [4P:341.1], (#.06) DEPOSIT TICKET [6P:344.1], (#.17) EFT RECORD [17P:344.31]
; Delete deposit if EDI Lockbox event and EFT referenced
I $P($G(^RCY(344,RCDA,0)),U,6),$P(^(0),U,17),$$EDILBEV^RCDPEU(+$P(^(0),U,4)) S DIE="^RCY(344,",DR=".06///@" D ^DIE
Q:'$D(^RCY(344,RCDA,0)) ; entry should still exist
;
; check if TYPE OF PAYMENT (#.04) changed from CHECK/MO PAYMENT to EDI LOCKBOX, update EFT on RECEIPT
I $P(RCBPYMNT(0),U,4)=4,$P(^RCY(344,RCDA,0),U,4)=14,$G(RCNE) D
.K DA,DR S DA=RCDA,DIE="^RCY(344,",DR=".17////"_RCNE D ^DIE
.D EFTUPD(RCNE,2) ; PRCA*4.5*321 - Change EFT status to PAPER EOB MATCH, notify user.
.D PAUSE
;
; check if TYPE OF PAYMENT (#.04) changed from EDI LOCKBOX to CHECK/MO PAYMENT, remove EFT from RECEIPT and
; update EDI THIRD PARTY EFT DETAIL status to UNMATCHED
I $P(RCBPYMNT(0),U,4)=14,$P(^RCY(344,RCDA,0),U,4)=4 D
.N DA,DR,DIE
.S DA=RCDA,DIE="^RCY(344,",DR=".17////@" D ^DIE
.D EFTUPD(+$P(RCBPYMNT(0),U,17),0) ; PRCA*4.5*321 call to change EFT status and notify user.
.D PAUSE
;
; PRCA*4.5*321 - Start changed block of code
; If this was an EDI LOCKBOX receipt where the EFT was changed insert new EFT
; and update original EDI THIRD PARTY EFT DETAIL status to UNMATCHED
I $P(RCBPYMNT(0),U,4)=14,$P(^RCY(344,RCDA,0),U,4)=14,$G(RCNE),$P(RCBPYMNT(0),U,17)'=RCNE D
.N DA,DR,DIE
.S DA=RCDA,DIE="^RCY(344,",DR=".17////"_RCNE D ^DIE
.D EFTUPD(+$P(RCBPYMNT(0),U,17),0) ; Change EFT status to UNMATCHED, notify user.
.D EFTUPD(RCNE,2) ; Change EFT status to PAPER EOB MATCH, notify user.
.D PAUSE
; PRCA*4.5*321 - End of changed block of code.
;
D LASTEDIT(RCDA) ; update (#.11) LAST EDITED BY , (#.12) DATE/TIME LAST EDIT
;
Q
;
;PRCA*4.5*409 Added method
EDITREC2(RCDA,OLDET,NEWEFT) ;EP from RCDPRPL3@EDITREC
; Edit Receipt action for Recipts with a payment type of OGC-CHK
N DA,DR,DIE
S DA=RCDA,DIE="^RCY(344,",DR=".17////"_NEWEFT
D ^DIE
D EFTUPD(OLDEFT,0) ; Change EFT status to UNMATCHED, notify user.
D EFTUPD(NEWEFT,2) ; Change EFT status to PAPER EOB MATCH, notify user.
D LASTEDIT(RCDA) ; update (#.11) LAST EDITED BY , (#.12) DATE/TIME LAST EDIT
Q
;
; PRCA*4.5*298 - updated comments in LBT
LBT(Y) ; Determine if Y should be set to @99 in DR string to skip field #.18 ERA REFERENCE
; DR(1,344,2)="I $P($G(^RCY(344,DA,0)),U,17) S Y=""@1001"";.06;@1001;D LBT^RCDPUREC(.Y);.18;@99"
; code below assumes DA,RCM3 are set
N Z,Z0
; Z will be true if TYPE OF PAYMENT [4P:341.1] is EDI LOCKBOX
S Z0=$G(^RCY(344,DA,0)),Z=($P(Z0,U,4)=$$LBEVENT^RCDPEU())
; (#.18) ERA REFERENCE [18P:344.4]
; Don't allow to edit ERA reference if worklist created it
; ^DD(344.49,.02,0) = "RECEIPT #^P344'^RCY(344,^0;2^Q"
I $P($G(^RCY(344.49,+$P(Z0,U,18),0)),U,2)=DA S Y="@99" Q
; only ask for ERA if not EDI lockbox and deposit # exists
I $S(Z:1,1:'$P($G(^RCY(344,DA,0)),U,6)) S Y="@99" Q
W !,RCM3 ; RCM,RCM1,RCM2,RCM3 set in SETV^RCDPURE1
Q
;
; PRCA*4.5*298 - updated logic and comments in TYP
TYP(Y) ; Determine where to jump to in the 'type' edit of
; Y - passed by ref. from DR string logic
; DR(1,344,1)="@20;.04;S RCNO=0,RCN4=X D TYP^RCDPUREC(.Y);.17////^S X=RCNE;S Y=""@22"";@21;.04////^S X=RCO4;I RCOE="""" S Y=""@23"";.17////^S X=RCOE;@23;W !,*7,$S(RCO4=14:$S('RCNO:RCM1,1:RCM2),1:RCM) S Y=""@20"";@22"
; Assumes RCP,RCNO,RCN4,RCO4,DA defined
N DIR,RCCHANGE,RCEFTSWP,RCERA,RCTRC
S RCTRC="" ; PRCA*4.5*367 - initialize to null in case no ERA has been assigned
S RCEFTSWP=EFTKEY&((RCO4=14)&(RCN4=14)) ; PRCA*4.5*321 - Allow edit of matched EFT with security key
; PRCA*4.5*367 - Skip to Receipt Total if new type is CHAMPVA
I $S(RCEFTSWP:0,RCN4=RCO4:1,(RCO4'=4)&(RCN4'=4)&(RCO4'=14)&(RCN4'=14):1,1:0) S Y=$S(RCN4=17:RCP+4,1:RCP+2) G TYPQ
; To get here, the type was changed and it either was 4 or 14 OR is now 4 or 14
; Or per PRCA*4.5*231 user has unmatch key and type is 14 (EDI LOCKBOX)
S RCCHANGE=(RCN4'=RCO4)
I RCCHANGE D G:Y TYPQ
.; PRCA*4.5*367 - CHECK/MO PAYMENT can be changed to CHAMPVA if trace number begins w/ TDA
.S RCERA=$P($G(^RCY(344,DA,0)),U,18) S:RCERA RCTRC=$P($G(^RCY(344.4,RCERA,0)),U,2)
.I $P(^RCY(344,DA,0),"^",14),RCN4=17,$E(RCTRC,1,3)'="TDA" D S Y=RCP Q
..S $P(^RCY(344,DA,0),U,4)=RCO4
..W !!,"The Payment Type can only be changed to "_$$GET1^DIQ(341.1,17,.01)_" if"
..W !,"matching ERA trace number begins with 'TDA'"
.; If receipt Status is OPEN, EDI LOCKBOX can only be changed to CHECK/MO PAYMENT and vice-versa
.; PRCA*4.5*367 - Allow CHECK/MO PAYMENT (4) to be switched to CHAMPVA (17)
.I $P(^RCY(344,DA,0),"^",14),(RCO4=4&(RCN4'=14)&(RCN4'=17))!(RCO4=14&(RCN4'=4)) D S Y=RCP Q ; PRCA*4.5*321
..S $P(^RCY(344,DA,0),"^",4)=RCO4
..W !!,"The Payment Type can only be changed to "
..W $S(RCO4=4:$$GET1^DIQ(341.1,14,.01)_" or "_$$GET1^DIQ(341.1,17,.01),1:$$GET1^DIQ(341.1,4,.01)),$C(7),!
.; Type can't be changed if the old type was EDI Lockbox and there is an ERA detail record
.; associated with it. Unless user has the UNMATCH EFT key.
.I 'EFTKEY,RCO4=14,$P($G(^RCY(344,DA,0)),U,18) S Y=RCP+1 Q ; PRCA*4.5*321
.; Type can't be changed to EDI Lockbox if receipt detail already exists. Unless user has the
.; UNMATCH EFT key.
.I 'EFTKEY,RCN4=14,$O(^RCY(344,DA,1,0)) S Y=RCP+1 Q ; PRCA*4.5*321
.; If payment type was EDI LOCKBOX and is to be changed to CHECK/MO PAYMENT (or vice-versa) confirm with user
.I (RCO4=14&(RCN4=4))!(RCO4=4&(RCN4=14)) D Q
..K DIR S DIR(0)="Y"
..S DIR("A")="Are you sure you want to change Payment Type to "_$$GET1^DIQ(341.1,RCN4,.01),DIR("B")="NO"
..W ! D ^DIR W !
..I 'Y S $P(^RCY(344,DA,0),"^",4)=RCO4,Y=RCP Q
..S:Y Y=RCP+2 S:RCN4=14 Y=0
;
; PRCA*4.5*367 - Skip to Receipt Total if new type is CHAMPVA
I RCN4'=14 S Y=$S(RCN4=17:RCP+4,1:RCP+2)
; fall through to TYPQ
TYPQ ;
; If type changed to EDI LOCKBOX, must have an EFT reference
I '$G(Y) D
.; If ERA is matched to EFT, don't allow to edit EFT unless user has key PRCA*4.5*321
.I 'EFTKEY,$P($G(^RCY(344,DA,0)),U,17),$P($G(^(0)),U,18),$D(^RCY(344.31,"AERA",+$P($G(^RCY(344,DA,0)),U,18),+$P($G(^RCY(344,DA,0)),U,17))) S Y=RCP+2 Q
.S RCNE=$$ASK17(DA) I 'RCNE S RCNO=1,Y=RCP+1 Q
;
I $G(Y) S Y="@"_Y
Q
;
LASTEDIT(DA) ; set when receipt last edit
N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
S (DIC,DIE)="^RCY(344,"
S DR=".11////"_DUZ_";.12///NOW;"
D ^DIE
Q
;
;
MARKPROC(DA,FMSDOCNO) ; mark receipt as processed, set receipt as closed,
; store fms document number if passed
N %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
S (DIC,DIE)="^RCY(344,"
S DR=".07////"_DUZ_";.08///NOW;.14////0;"
I $G(FMSDOCNO)'="" S DR=DR_"200////"_FMSDOCNO_";"
D ^DIE
Q
;
FMSSTAT(RCRECTDA) ; return the fms cr document ^ status ^ if sent before lockbox
N FMSDOCNO,PRELOCK,STATUS
; get the fms document from the receipt
S FMSDOCNO=$P($G(^RCY(344,RCRECTDA,2)),"^")
; if not on receipt, it may be earlier than lockbox and on deposit
I FMSDOCNO="" S FMSDOCNO=$P($G(^RCY(344.1,+$P($G(^RCY(344,RCRECTDA,0)),"^",6),2)),"^") I FMSDOCNO'="" S PRELOCK=1
S STATUS=$$STATUS^GECSSGET(FMSDOCNO)
I STATUS=-1 S STATUS="NOT ENTERED"
;
; if the cr document is entered, check to see if entered on line
I FMSDOCNO'="",$P($G(^RCY(344,RCRECTDA,2)),"^",2) S STATUS="ON LINE ENTRY"
;
; if the cr document is missing, set status to not sent
I FMSDOCNO="" S FMSDOCNO="NOT SENT"
;
Q FMSDOCNO_"^"_STATUS_"^"_$G(PRELOCK)
;
; PRCA*4.5*321 - Updated for UNMATCH key changes
ASK17(DA) ; function, Ask, return the EFT detail record IEN for a receipt
; Input: DA = the ien of the RECEIPT (file 344)
; Returns: IEN in EDI THIRD PARTY EFT DETAIL (#344.31) or zero
N DIR,OLDEFT,RCARR,QUIT,X,Y
S OLDEFT=$P($G(^RCY(344,DA,0)),U,17)
S QUIT=0
I OLDEFT D I QUIT Q 0 ; Quit here if user does not want to change EFT
. N DIR,DUOUT,DTOUT,X,Y
. D GETS^DIQ(344.31,OLDEFT_",",".01;.02;.04;.07","","RCARR")
. W !,"Existing EFT: "_$$GET1^DIQ(344.31,OLDEFT_",",.01,"E")_" "_RCARR(344.31,OLDEFT_",",.02) ; PRCA*4.5*326
. W " "_RCARR(344.31,OLDEFT_",",.04)_" "_RCARR(344.31,OLDEFT_",",.07)
. W !
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Match a different EFT to this receipt"
. S DIR("?",1)="The receipt is currently matched to the EFT listed above."
. S DIR("?",2)="If you answer 'Y' or 'YES' you will be prompted for a different EFT"
. S DIR("?",3)="to match with this receipt."
. S DIR("?")="If you answer 'N' or 'NO', no change will be made."
. D ^DIR
. I $D(DUOUT)!$D(DTOUT)!('Y) S QUIT=1
;
; BEGIN - PRCA*4.5*326 - replace ^DIR with ^DIC
G17 ; Reprompt for new EFT
N FDA,RCPROMPT,RCSCREEN,Y
S RCPROMPT=" NEW EFT DETAIL RECORD: "
S RCSCREEN="I ('$P(^(0),U,8))&($P($G(^(0)),U,7))&('$P($G(^(3)),U))"
;
;PRCA*4.5*409 Begin
I $P(^RCY(344,DA,0),"^",4)=18 D
. S RCSCREEN=RCSCREEN_",$E($P($G(^(0)),U,4),1,3)=""OGC"""
I $P(^RCY(344,DA,0),"^",4)=14 D
. S RCSCREEN=RCSCREEN_",$E($P($G(^(0)),U,4),1,3)'=""OGC"""
;
;PRCA*4.5*409 End
G1 S Y=$$ASKEFT^RCDPEU2(RCPROMPT,RCSCREEN)
I Y=-1 Q 0
I Y=0 D G G1
. W !,*7,"Must have an EFT for an EDI Lockbox payment type"
; END - PRCA*4.5*326
Q Y
;
EFTKEY() ;Check if user has UNMATCH EFT key
; Input: None
; Returns; 1 if user owns RCDPEPP key ; otherwise 0.
N MSG
D OWNSKEY^XUSRB(.MSG,"RCDPEPP",DUZ)
Q MSG(0)
;
EFTUPD(DA,MATCH) ; Update EFT record if payment type is changed
; Input: DA = Internal entry number of EFT record.
; MATCH = New match status for the EFT
; Output: Notification to user screen, RCMSG.
N DIE,DIR,DR,RCMSG,X,Y
S DIE="^RCY(344.31,"
I DA S DR=".08////"_MATCH D ^DIE
S Y=$$GET1^DIQ(344.31,DA_",",.01,"E") ; PRCA*4.5*326
I Y D ;
. S RCMSG="EFT TRANSACTION "_Y_" updated to "_$$GET1^DIQ(344.31,DA_",",.08,"E")
E S RCMSG="* EFT RECORD not found! *"
W !," "_RCMSG
Q
PAUSE ; Pause screen till user hits enter
; Input: None
; output: None
N DIR,X,Y
S DIR(0)="EA",DIR("A")="Press return: " D ^DIR
Q
;
DIC19 ;
S G="^DIC(19)" F S G=$Q(@G) Q:'$P(G,"^DIC(",2)=19 I @G["IDP" W !,G,!,@G
;
Q
;
ISCHMPVA(RCTYP) ; Returns whether the given receipt type is CHAMPVA or not
Q $P($G(^RC(341.1,+$G(RCTYP),0)),U,2)=17
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPUREC 19078 printed Sep 23, 2025@19:22:44 Page 2
RCDPUREC ;WISC/RFJ - receipt utilities ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**114,148,169,173,208,222,293,298,321,326,380,367,371,409**;Mar 20, 1995;Build 17
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
ADDRECT(TRANDATE,RCDEPTDA,PAYTYPDA) ;EP Add a receipt
+1 ; Input: TRANDATE - Deposit Date in fileman format
+2 ; RCDEPTDA - IEN in AR DEPOSIT file (#344.1)
+3 ; PAYTYPDA - AR Event Type IEN (#341.1)
+4 ; Returns: 0 - No receipt added or receipt IEN otherwise
+5 ;
+6 ; If deposit or payment type is missing, do not add the receipt
+7 IF 'RCDEPTDA!('PAYTYPDA)
QUIT 0
+8 ;
+9 NEW DA,DATA,RCDPFLAG,RECEIPT,TYPE
+10 ;
+11 ; If a receipt has already been added for this transmission date
+12 ; and deposit number, do not add a new one
+13 ;PRCA*4.5*380 - Removed to allow for duplicate deposit number/date records
+14 ;S DA=0 F S DA=$O(^RCY(344,"AD",+RCDEPTDA,DA)) Q:'DA S DATA=$G(^RCY(344,DA,0)) I $P($P(DATA,"^",3),".")=TRANDATE,$P(DATA,"^",4)=PAYTYPDA S RCDPFLAG=1 Q
+15 ;I $G(RCDPFLAG) Q DA
+16 ;
+17 QUIT $$BLDRCPT(TRANDATE,RCDEPTDA,PAYTYPDA)
+18 ;
BLDRCPT(TRANDATE,RCDEPTDA,PAYTYPDA,RCDUZ) ;EP Build a receipt with/without deposit
+1 ; LAYGO new entry to AR BATCH PAYMENT file (#344)
+2 ; Input: TRANDATE - Deposit Date in fileman format
+3 ; RCDEPTDA - IEN in AR DEPOSIT file (#344.1)
+4 ; PAYTYPDA - AR Event Type IEN (#341.1)
+5 ; RCDUZ - User IEN (#200)
+6 ; Returns: New IEN on success, else zero
+7 ;
+8 NEW GOTONE,RECEIPT,TYPE
+9 ; ATTMPT - Count of attempts
+10 ; GOTONE - New receipt # flag
+11 SET GOTONE=0
+12 ;
+13 ; Build unique receipt number for date
+14 ;PRCA*4.5*409 '0' if PAYTYPDA=18 for OGC-EFT
SET TYPE=$EXTRACT($GET(^RC(341.1,PAYTYPDA,0)),1)
+15 ; ^RC(341.1,0) = AR EVENT TYPE
IF TYPE=""
SET TYPE="Z"
+16 ; ERA plus paper check EDI Lockbox receipt
IF TYPE="C"
IF $GET(RCDEPTDA)["ERACHK"
SET RCDEPTDA=+RCDEPTDA
SET TYPE="E"
+17 ;
+18 ; Accounts Receivable Nightly Process Background Job [PRCA NIGHTLY PROCESS]
+19 ; -----
+20 ;
+21 ;lockbox receipt in the form of L980901A0, do not include century
+22 ; Must be new and non-null
FOR
Begin DoDot:1
+23 ;
+24 ; Find a unique receipt #
+25 ; Get last two digits from 00 to ZZ
SET RECEIPT=$$NEXT(TYPE_$EXTRACT(TRANDATE,2,7))
+26 IF RECEIPT=""
QUIT
+27 ; AR BATCH PAYMENT file (#344), RECEIPT # field (#.01)
IF $DATA(^RCY(344,"B",RECEIPT))
QUIT
+28 ; AR TRANSACTION file (#433), RECEIPT # field (#13)
IF $DATA(^PRCA(433,"AF",RECEIPT))
QUIT
+29 SET GOTONE=1
End DoDot:1
if +GOTONE&$LENGTH(RECEIPT)
QUIT
+30 ;
+31 ;
+32 ;PRCA*4.5*298, if LOCK timeout return zero
LOCK +^RCY(344,"B",RECEIPT):DILOCKTM
IF '$TEST
QUIT 0
+33 ;
+34 ; Add entry to AR BATCH PAYMENT file (#344)
+35 NEW %,%DT,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,X,Y
+36 SET DIC="^RCY(344,"
SET DIC(0)="L"
SET DLAYGO=344
+37 ; .02 = opened by .03 = date opened = transmission dt
+38 ; .04 = type of payment .06 = deposit ticket
+39 ; .14 = status (set to 1:open)
+40 ; PRCA*4.5*326 Use RCDUZ passed in
SET DIC("DR")=".02////"_$SELECT($GET(RCDUZ):RCDUZ,1:DUZ)
+41 SET DIC("DR")=DIC("DR")_";.03///"_TRANDATE_";.04////"_PAYTYPDA_$SELECT(RCDEPTDA:";.06////"_RCDEPTDA,1:"")_";.14////1;"
+42 SET X=RECEIPT
+43 DO FILE^DICN
+44 LOCK -^RCY(344,"B",RECEIPT)
+45 ; Y set by DICN, return new IEN
IF Y>0
QUIT +Y
+46 ; Entry not created
QUIT 0
+47 ;
NEXT(RECEIPT) ; function, get next 2 chars. in sequence 00 to ZZ for receipt
+1 ;
+2 ; start with 00
+3 IF '$DATA(^RCY(344,"B",RECEIPT_"00"))
IF '$DATA(^RCY(344,"B",RECEIPT_"00A"))
QUIT RECEIPT_"00"
+4 ;
+5 NEW DIGIT1,DIGIT2,LAST
+6 ; get the last one used and increment by 1
+7 ;example L2980901ZZ
SET LAST=$ORDER(^RCY(344,"B",RECEIPT_"ZZ"),-1)
+8 SET DIGIT1=$ASCII($EXTRACT(LAST,8))
SET DIGIT2=$ASCII($EXTRACT(LAST,9))
+9 ; increment the ascii value of last digit
+10 SET DIGIT2=DIGIT2+1
+11 ; ascii 48=0, 57=9, 65=A, 90=Z
+12 ;an A
IF DIGIT2>57
IF DIGIT2<65
SET DIGIT2=65
+13 ; digit2 above a Z, set digit2 to a 0 and increment digit 1
+14 IF DIGIT2>90
SET DIGIT2=48
SET DIGIT1=DIGIT1+1
+15 ;an A
IF DIGIT1>57
IF DIGIT1<65
SET DIGIT1=65
+16 ; digit 1 is above a Z, reset and reuse the Z
+17 IF DIGIT1>90
SET DIGIT1=90
SET DIGIT2=90
+18 ;
+19 ; If Receipt # already on file get another one
+20 FOR
if '$DATA(^RCY(344,"B",RECEIPT_$CHAR(DIGIT1)_$CHAR(DIGIT2)))
QUIT
Begin DoDot:1
+21 SET RECEIPT=$EXTRACT(RECEIPT,1)_$EXTRACT(1000001+$EXTRACT(RECEIPT,2,7),2,7)
End DoDot:1
+22 ;
+23 QUIT RECEIPT_$CHAR(DIGIT1)_$CHAR(DIGIT2)
+24 ;
+25 ;
SELRECT(ADDNEW,RCDEPTDA) ; select a receipt
+1 ; if $g(addnew) allow adding a new receipt
+2 ; if $g(rcdeptda) allow selection of receipts for the deposit only
+3 ; if $g(addnew) and $g(rcdeptda) deposit number auto set for new receipt
+4 ; returns -1 for timeout or ^, 0 for no selection, or ien of receipt
+5 NEW %,%Y,C,D0,DA,DG,DI,DIC,DIE,DIK,DLAYGO,DQ,DR,DTOUT,DUOUT
+6 ;PRCA*4.5*409 Added RCPAYTYP
NEW RC1,RC2,RCDE,RCHMP,RCLB,RCPAYTYP,RCREFLUP,RCREQ,RCY,X,Y
+7 SET RCPAYTYP=""
+8 SET DIC="^RCY(344,"
SET DIC(0)="QEAM"
SET DIC("A")="Select RECEIPT: "
+9 SET DIC("W")="D DICW^RCDPUREC"
+10 ; set screen to select receipts linked to deposit and to screen out
+11 ; selection of EDI Lockbox-type receipts unless an EFT is associated
+12 ; with the deposit and the receipt is not associated with an ERA
+13 SET RCDE=+$ORDER(^RCY(344.3,"ARDEP",+$GET(RCDEPTDA),0))
+14 IF $GET(RCDEPTDA)
Begin DoDot:1
+15 SET DIC("S")="N Z S Z=$G(^(0)) I $S('$$EDILBEV^RCDPEU($P(Z,U,4)):'RCDE,1:RCDE&'$P(Z,U,18)),($P(Z,U,6)=""""!($P(Z,U,6)=RCDEPTDA))"
+16 SET DIC("A")="Select RECEIPT (for deposit "_$PIECE(^RCY(344.1,RCDEPTDA,0),"^")_"): "
End DoDot:1
+17 ; use special lookup on input
+18 IF '$GET(RCDEPTDA)
SET RCREFLUP=1
+19 ; add new entries
+20 SET RC1="TYPE NOT VALID FOR THIS RECEIPT"
SET RC2=">>AN EFT REFERENCE IS REQUIRED"
+21 IF $GET(ADDNEW)
Begin DoDot:1
+22 SET DIC("A")="Select RECEIPT (or add a new one): "
+23 SET DIC(0)="QEALM"
SET DLAYGO=344
+24 SET DIC("DR")="S RCREQ=0;.02////"_DUZ_";.03///NOW;.14////1;@4;.04"_$SELECT(RCDE:"////"_$$LBEVENT^RCDPEU(),1:"")
+25 ; Next line use EFT picker utility instead of .17 in DR string - PRCA*4.5*326
+26 ; Do not delete DIC("W") from the DR string. It has a role in ^DIC flow if an EFT is not picked.
+27 ; PRCA*4.5*367 - If type is CHAMPVA, jump to setting receipt total then exit
+28 ; PRCA*4.5*409 Added RCPAYTYP=+X,
+29 SET DIC("DR")=DIC("DR")_";S RCPAYTYP=+X,RCLB=$$EDILBEV^RCDPEU(RCPAYTYP),RCHMP=$$ISCHMPVA^RCDPUREC(+$G(X)) S:'RCLB Y=""@6"" S:RCHMP Y=""@9"";I $G(RCDEPTDA) S Y=$S('RCDE:""@8"",1:""@6"");W !,RC2 S RCREQ=1,DIC(""W"")="""""
+30 ; PRCA*4.5*409 Added ,RCPAYTYP
+31 SET DIC("DR")=DIC("DR")_";D EFT344^RCDPEU2("" AR BATCH PAYMENT EFT RECORD: "",DA,RCPAYTYP);S Y=""@99"";@6;.06"_$SELECT($GET(RCDEPTDA):"////"_RCDEPTDA,1:"")_";S:'RCDE Y=""@99"";.17////"_+RCDE_";S Y=""@99"";@8;W *7,!,RC1 S Y=""@4"";@9;.
22;@99"
+32 SET DIC("DR")=DIC("DR")_";"
End DoDot:1
+33 DO ^DIC
+34 SET RCY=Y
+35 IF RCY<0
IF '$GET(DUOUT)
IF '$GET(DTOUT)
SET RCY=0
+36 IF $PIECE(RCY,U,3)
IF $GET(RCREQ)
Begin DoDot:1
+37 IF '$PIECE($GET(^RCY(344,+RCY,0)),U,17)
Begin DoDot:2
+38 WRITE !,*7,"NO EFT REFERENCED - RECEIPT NOT ADDED"
+39 SET DA=+RCY
SET DIK="^RCY(344,"
DO ^DIK
+40 SET RCY=0
End DoDot:2
QUIT
+41 SET DIE="^RCY(344.31,"
SET DA=$PIECE(^RCY(344,+RCY,0),U,17)
SET DR=".08////2"
DO ^DIE
End DoDot:1
+42 QUIT +RCY
+43 ;
+44 ;
DICW ; write identifier code for receipt lookup
+1 NEW DATA
+2 SET DATA=$GET(^RCY(344,Y,0))
IF DATA=""
QUIT
+3 ; opened by
+4 WRITE ?13,"by: ",$EXTRACT($PIECE($GET(^VA(200,+$PIECE(DATA,"^",2),0)),"^"),1,15)
+5 ; date opened
+6 IF '$PIECE(DATA,"^",3)
SET $PIECE(DATA,"^",3)="???????"
+7 WRITE ?35," on: ",$EXTRACT($PIECE(DATA,"^",3),4,5),"/",$EXTRACT($PIECE(DATA,"^",3),6,7),"/",$EXTRACT($PIECE(DATA,"^",3),2,3)
+8 ; type of payment
+9 WRITE ?50," ",$EXTRACT($PIECE($GET(^RC(341.1,+$PIECE(DATA,"^",4),0)),"^"),1,18)
+10 ; status
+11 WRITE ?70," ",$SELECT($PIECE(DATA,"^",14):"OPEN",1:"CLOSED")
+12 QUIT
+13 ;
+14 ;
LOOKUP ; special lookup on receipts, called from ^dd(344,.01,7.5)
+1 ; if rcreflup flag not set, do not use special lookup
+2 IF '$DATA(RCREFLUP)
QUIT
+3 ; user entered O.? for lookup on open receipts
+4 IF X["O."!(X["o.")
SET DIC("S")="I $P(^(0),U,14)"
SET X="?"
QUIT
+5 ; user entered C.? for lookup on closed receipts
+6 IF X["C."!(X["c.")
SET DIC("S")="I '$P(^(0),U,14)"
SET X="?"
QUIT
+7 KILL DIC("S")
+8 QUIT
+9 ;
+10 ; PRCA*4.5*298 - updated logic and comments in EDITREC
EDITREC(DA,DR) ; edit the receipt (DR = string of fields to ask) in AR BATCH PAYMENT file (#344)
+1 ; RCBPYMNT - AR BATCH PAYMENT entry before edit
+2 ; PRCA*4.5*371 Added RCNE
NEW D,D0,DI,DIC,DIE,DQ,EFTKEY,RCBPYMNT,RCDA,RCDR1,RCDR2,RCDR3,RCNE,X,Y
+3 SET (DIC,DIE)="^RCY(344,"
SET RCDA=DA
+4 ; PRCA*4.5*321 - Check if user has key to unmatch EFTs
SET EFTKEY=$$EFTKEY()
+5 IF $GET(DR)=""
NEW DR
Begin DoDot:1
+6 SET DR=".01;.04;"_$SELECT($PIECE($GET(^RCY(344,RCDA,0)),U,17):"",1:"I $P($G(^RCY(344,DA,0)),U,17) S Y=""@1001"";.06;@1001;")_"D LBT^RCDPUREC(.Y);.18;@99"
End DoDot:1
+7 ;
+8 ; Add a check to DR string for type of payment edit
IF $GET(DR)[".04;"
Begin DoDot:1
+9 ; get new DR strings in RCDR1,RCDR2,RCDR3
DO EDIT4^RCDPURE1(RCDA,DR,.RCDR1,.RCDR2,.RCDR3)
+10 SET DR=$SELECT($EXTRACT(RCDR1,$LENGTH(RCDR1))'=";":RCDR1,1:$EXTRACT(RCDR1,1,$LENGTH(RCDR1)-1))
SET DR(1,344,1)=RCDR2
SET DR(1,344,2)=RCDR3
End DoDot:1
+11 ;
+12 ; save initial values
MERGE RCBPYMNT=^RCY(344,DA)
+13 ;
+14 DO ^DIE
+15 ;
+16 ; (#.04) TYPE OF PAYMENT [4P:341.1], (#.06) DEPOSIT TICKET [6P:344.1], (#.17) EFT RECORD [17P:344.31]
+17 ; Delete deposit if EDI Lockbox event and EFT referenced
+18 IF $PIECE($GET(^RCY(344,RCDA,0)),U,6)
IF $PIECE(^(0),U,17)
IF $$EDILBEV^RCDPEU(+$PIECE(^(0),U,4))
SET DIE="^RCY(344,"
SET DR=".06///@"
DO ^DIE
+19 ; entry should still exist
if '$DATA(^RCY(344,RCDA,0))
QUIT
+20 ;
+21 ; check if TYPE OF PAYMENT (#.04) changed from CHECK/MO PAYMENT to EDI LOCKBOX, update EFT on RECEIPT
+22 IF $PIECE(RCBPYMNT(0),U,4)=4
IF $PIECE(^RCY(344,RCDA,0),U,4)=14
IF $GET(RCNE)
Begin DoDot:1
+23 KILL DA,DR
SET DA=RCDA
SET DIE="^RCY(344,"
SET DR=".17////"_RCNE
DO ^DIE
+24 ; PRCA*4.5*321 - Change EFT status to PAPER EOB MATCH, notify user.
DO EFTUPD(RCNE,2)
+25 DO PAUSE
End DoDot:1
+26 ;
+27 ; check if TYPE OF PAYMENT (#.04) changed from EDI LOCKBOX to CHECK/MO PAYMENT, remove EFT from RECEIPT and
+28 ; update EDI THIRD PARTY EFT DETAIL status to UNMATCHED
+29 IF $PIECE(RCBPYMNT(0),U,4)=14
IF $PIECE(^RCY(344,RCDA,0),U,4)=4
Begin DoDot:1
+30 NEW DA,DR,DIE
+31 SET DA=RCDA
SET DIE="^RCY(344,"
SET DR=".17////@"
DO ^DIE
+32 ; PRCA*4.5*321 call to change EFT status and notify user.
DO EFTUPD(+$PIECE(RCBPYMNT(0),U,17),0)
+33 DO PAUSE
End DoDot:1
+34 ;
+35 ; PRCA*4.5*321 - Start changed block of code
+36 ; If this was an EDI LOCKBOX receipt where the EFT was changed insert new EFT
+37 ; and update original EDI THIRD PARTY EFT DETAIL status to UNMATCHED
+38 IF $PIECE(RCBPYMNT(0),U,4)=14
IF $PIECE(^RCY(344,RCDA,0),U,4)=14
IF $GET(RCNE)
IF $PIECE(RCBPYMNT(0),U,17)'=RCNE
Begin DoDot:1
+39 NEW DA,DR,DIE
+40 SET DA=RCDA
SET DIE="^RCY(344,"
SET DR=".17////"_RCNE
DO ^DIE
+41 ; Change EFT status to UNMATCHED, notify user.
DO EFTUPD(+$PIECE(RCBPYMNT(0),U,17),0)
+42 ; Change EFT status to PAPER EOB MATCH, notify user.
DO EFTUPD(RCNE,2)
+43 DO PAUSE
End DoDot:1
+44 ; PRCA*4.5*321 - End of changed block of code.
+45 ;
+46 ; update (#.11) LAST EDITED BY , (#.12) DATE/TIME LAST EDIT
DO LASTEDIT(RCDA)
+47 ;
+48 QUIT
+49 ;
+50 ;PRCA*4.5*409 Added method
EDITREC2(RCDA,OLDET,NEWEFT) ;EP from RCDPRPL3@EDITREC
+1 ; Edit Receipt action for Recipts with a payment type of OGC-CHK
+2 NEW DA,DR,DIE
+3 SET DA=RCDA
SET DIE="^RCY(344,"
SET DR=".17////"_NEWEFT
+4 DO ^DIE
+5 ; Change EFT status to UNMATCHED, notify user.
DO EFTUPD(OLDEFT,0)
+6 ; Change EFT status to PAPER EOB MATCH, notify user.
DO EFTUPD(NEWEFT,2)
+7 ; update (#.11) LAST EDITED BY , (#.12) DATE/TIME LAST EDIT
DO LASTEDIT(RCDA)
+8 QUIT
+9 ;
+10 ; PRCA*4.5*298 - updated comments in LBT
LBT(Y) ; Determine if Y should be set to @99 in DR string to skip field #.18 ERA REFERENCE
+1 ; DR(1,344,2)="I $P($G(^RCY(344,DA,0)),U,17) S Y=""@1001"";.06;@1001;D LBT^RCDPUREC(.Y);.18;@99"
+2 ; code below assumes DA,RCM3 are set
+3 NEW Z,Z0
+4 ; Z will be true if TYPE OF PAYMENT [4P:341.1] is EDI LOCKBOX
+5 SET Z0=$GET(^RCY(344,DA,0))
SET Z=($PIECE(Z0,U,4)=$$LBEVENT^RCDPEU())
+6 ; (#.18) ERA REFERENCE [18P:344.4]
+7 ; Don't allow to edit ERA reference if worklist created it
+8 ; ^DD(344.49,.02,0) = "RECEIPT #^P344'^RCY(344,^0;2^Q"
+9 IF $PIECE($GET(^RCY(344.49,+$PIECE(Z0,U,18),0)),U,2)=DA
SET Y="@99"
QUIT
+10 ; only ask for ERA if not EDI lockbox and deposit # exists
+11 IF $SELECT(Z:1,1:'$PIECE($GET(^RCY(344,DA,0)),U,6))
SET Y="@99"
QUIT
+12 ; RCM,RCM1,RCM2,RCM3 set in SETV^RCDPURE1
WRITE !,RCM3
+13 QUIT
+14 ;
+15 ; PRCA*4.5*298 - updated logic and comments in TYP
TYP(Y) ; Determine where to jump to in the 'type' edit of
+1 ; Y - passed by ref. from DR string logic
+2 ; DR(1,344,1)="@20;.04;S RCNO=0,RCN4=X D TYP^RCDPUREC(.Y);.17////^S X=RCNE;S Y=""@22"";@21;.04////^S X=RCO4;I RCOE="""" S Y=""@23"";.17////^S X=RCOE;@23;W !,*7,$S(RCO4=14:$S('RCNO:RCM1,1:RCM2),1:RCM) S Y=""@20"";@22"
+3 ; Assumes RCP,RCNO,RCN4,RCO4,DA defined
+4 NEW DIR,RCCHANGE,RCEFTSWP,RCERA,RCTRC
+5 ; PRCA*4.5*367 - initialize to null in case no ERA has been assigned
SET RCTRC=""
+6 ; PRCA*4.5*321 - Allow edit of matched EFT with security key
SET RCEFTSWP=EFTKEY&((RCO4=14)&(RCN4=14))
+7 ; PRCA*4.5*367 - Skip to Receipt Total if new type is CHAMPVA
+8 IF $SELECT(RCEFTSWP:0,RCN4=RCO4:1,(RCO4'=4)&(RCN4'=4)&(RCO4'=14)&(RCN4'=14):1,1:0)
SET Y=$SELECT(RCN4=17:RCP+4,1:RCP+2)
GOTO TYPQ
+9 ; To get here, the type was changed and it either was 4 or 14 OR is now 4 or 14
+10 ; Or per PRCA*4.5*231 user has unmatch key and type is 14 (EDI LOCKBOX)
+11 SET RCCHANGE=(RCN4'=RCO4)
+12 IF RCCHANGE
Begin DoDot:1
+13 ; PRCA*4.5*367 - CHECK/MO PAYMENT can be changed to CHAMPVA if trace number begins w/ TDA
+14 SET RCERA=$PIECE($GET(^RCY(344,DA,0)),U,18)
if RCERA
SET RCTRC=$PIECE($GET(^RCY(344.4,RCERA,0)),U,2)
+15 IF $PIECE(^RCY(344,DA,0),"^",14)
IF RCN4=17
IF $EXTRACT(RCTRC,1,3)'="TDA"
Begin DoDot:2
+16 SET $PIECE(^RCY(344,DA,0),U,4)=RCO4
+17 WRITE !!,"The Payment Type can only be changed to "_$$GET1^DIQ(341.1,17,.01)_" if"
+18 WRITE !,"matching ERA trace number begins with 'TDA'"
End DoDot:2
SET Y=RCP
QUIT
+19 ; If receipt Status is OPEN, EDI LOCKBOX can only be changed to CHECK/MO PAYMENT and vice-versa
+20 ; PRCA*4.5*367 - Allow CHECK/MO PAYMENT (4) to be switched to CHAMPVA (17)
+21 ; PRCA*4.5*321
IF $PIECE(^RCY(344,DA,0),"^",14)
IF (RCO4=4&(RCN4'=14)&(RCN4'=17))!(RCO4=14&(RCN4'=4))
Begin DoDot:2
+22 SET $PIECE(^RCY(344,DA,0),"^",4)=RCO4
+23 WRITE !!,"The Payment Type can only be changed to "
+24 WRITE $SELECT(RCO4=4:$$GET1^DIQ(341.1,14,.01)_" or "_$$GET1^DIQ(341.1,17,.01),1:$$GET1^DIQ(341.1,4,.01)),$CHAR(7),!
End DoDot:2
SET Y=RCP
QUIT
+25 ; Type can't be changed if the old type was EDI Lockbox and there is an ERA detail record
+26 ; associated with it. Unless user has the UNMATCH EFT key.
+27 ; PRCA*4.5*321
IF 'EFTKEY
IF RCO4=14
IF $PIECE($GET(^RCY(344,DA,0)),U,18)
SET Y=RCP+1
QUIT
+28 ; Type can't be changed to EDI Lockbox if receipt detail already exists. Unless user has the
+29 ; UNMATCH EFT key.
+30 ; PRCA*4.5*321
IF 'EFTKEY
IF RCN4=14
IF $ORDER(^RCY(344,DA,1,0))
SET Y=RCP+1
QUIT
+31 ; If payment type was EDI LOCKBOX and is to be changed to CHECK/MO PAYMENT (or vice-versa) confirm with user
+32 IF (RCO4=14&(RCN4=4))!(RCO4=4&(RCN4=14))
Begin DoDot:2
+33 KILL DIR
SET DIR(0)="Y"
+34 SET DIR("A")="Are you sure you want to change Payment Type to "_$$GET1^DIQ(341.1,RCN4,.01)
SET DIR("B")="NO"
+35 WRITE !
DO ^DIR
WRITE !
+36 IF 'Y
SET $PIECE(^RCY(344,DA,0),"^",4)=RCO4
SET Y=RCP
QUIT
+37 if Y
SET Y=RCP+2
if RCN4=14
SET Y=0
End DoDot:2
QUIT
End DoDot:1
if Y
GOTO TYPQ
+38 ;
+39 ; PRCA*4.5*367 - Skip to Receipt Total if new type is CHAMPVA
+40 IF RCN4'=14
SET Y=$SELECT(RCN4=17:RCP+4,1:RCP+2)
+41 ; fall through to TYPQ
TYPQ ;
+1 ; If type changed to EDI LOCKBOX, must have an EFT reference
+2 IF '$GET(Y)
Begin DoDot:1
+3 ; If ERA is matched to EFT, don't allow to edit EFT unless user has key PRCA*4.5*321
+4 IF 'EFTKEY
IF $PIECE($GET(^RCY(344,DA,0)),U,17)
IF $PIECE($GET(^(0)),U,18)
IF $DATA(^RCY(344.31,"AERA",+$PIECE($GET(^RCY(344,DA,0)),U,18),+$PIECE($GET(^RCY(344,DA,0)),U,17)))
SET Y=RCP+2
QUIT
+5 SET RCNE=$$ASK17(DA)
IF 'RCNE
SET RCNO=1
SET Y=RCP+1
QUIT
End DoDot:1
+6 ;
+7 IF $GET(Y)
SET Y="@"_Y
+8 QUIT
+9 ;
LASTEDIT(DA) ; set when receipt last edit
+1 NEW %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
+2 SET (DIC,DIE)="^RCY(344,"
+3 SET DR=".11////"_DUZ_";.12///NOW;"
+4 DO ^DIE
+5 QUIT
+6 ;
+7 ;
MARKPROC(DA,FMSDOCNO) ; mark receipt as processed, set receipt as closed,
+1 ; store fms document number if passed
+2 NEW %DT,D,D0,DI,DIC,DIE,DQ,DR,X,Y
+3 SET (DIC,DIE)="^RCY(344,"
+4 SET DR=".07////"_DUZ_";.08///NOW;.14////0;"
+5 IF $GET(FMSDOCNO)'=""
SET DR=DR_"200////"_FMSDOCNO_";"
+6 DO ^DIE
+7 QUIT
+8 ;
FMSSTAT(RCRECTDA) ; return the fms cr document ^ status ^ if sent before lockbox
+1 NEW FMSDOCNO,PRELOCK,STATUS
+2 ; get the fms document from the receipt
+3 SET FMSDOCNO=$PIECE($GET(^RCY(344,RCRECTDA,2)),"^")
+4 ; if not on receipt, it may be earlier than lockbox and on deposit
+5 IF FMSDOCNO=""
SET FMSDOCNO=$PIECE($GET(^RCY(344.1,+$PIECE($GET(^RCY(344,RCRECTDA,0)),"^",6),2)),"^")
IF FMSDOCNO'=""
SET PRELOCK=1
+6 SET STATUS=$$STATUS^GECSSGET(FMSDOCNO)
+7 IF STATUS=-1
SET STATUS="NOT ENTERED"
+8 ;
+9 ; if the cr document is entered, check to see if entered on line
+10 IF FMSDOCNO'=""
IF $PIECE($GET(^RCY(344,RCRECTDA,2)),"^",2)
SET STATUS="ON LINE ENTRY"
+11 ;
+12 ; if the cr document is missing, set status to not sent
+13 IF FMSDOCNO=""
SET FMSDOCNO="NOT SENT"
+14 ;
+15 QUIT FMSDOCNO_"^"_STATUS_"^"_$GET(PRELOCK)
+16 ;
+17 ; PRCA*4.5*321 - Updated for UNMATCH key changes
ASK17(DA) ; function, Ask, return the EFT detail record IEN for a receipt
+1 ; Input: DA = the ien of the RECEIPT (file 344)
+2 ; Returns: IEN in EDI THIRD PARTY EFT DETAIL (#344.31) or zero
+3 NEW DIR,OLDEFT,RCARR,QUIT,X,Y
+4 SET OLDEFT=$PIECE($GET(^RCY(344,DA,0)),U,17)
+5 SET QUIT=0
+6 ; Quit here if user does not want to change EFT
IF OLDEFT
Begin DoDot:1
+7 NEW DIR,DUOUT,DTOUT,X,Y
+8 DO GETS^DIQ(344.31,OLDEFT_",",".01;.02;.04;.07","","RCARR")
+9 ; PRCA*4.5*326
WRITE !,"Existing EFT: "_$$GET1^DIQ(344.31,OLDEFT_",",.01,"E")_" "_RCARR(344.31,OLDEFT_",",.02)
+10 WRITE " "_RCARR(344.31,OLDEFT_",",.04)_" "_RCARR(344.31,OLDEFT_",",.07)
+11 WRITE !
+12 SET DIR(0)="Y"
SET DIR("B")="NO"
+13 SET DIR("A")="Match a different EFT to this receipt"
+14 SET DIR("?",1)="The receipt is currently matched to the EFT listed above."
+15 SET DIR("?",2)="If you answer 'Y' or 'YES' you will be prompted for a different EFT"
+16 SET DIR("?",3)="to match with this receipt."
+17 SET DIR("?")="If you answer 'N' or 'NO', no change will be made."
+18 DO ^DIR
+19 IF $DATA(DUOUT)!$DATA(DTOUT)!('Y)
SET QUIT=1
End DoDot:1
IF QUIT
QUIT 0
+20 ;
+21 ; BEGIN - PRCA*4.5*326 - replace ^DIR with ^DIC
G17 ; Reprompt for new EFT
+1 NEW FDA,RCPROMPT,RCSCREEN,Y
+2 SET RCPROMPT=" NEW EFT DETAIL RECORD: "
+3 SET RCSCREEN="I ('$P(^(0),U,8))&($P($G(^(0)),U,7))&('$P($G(^(3)),U))"
+4 ;
+5 ;PRCA*4.5*409 Begin
+6 IF $PIECE(^RCY(344,DA,0),"^",4)=18
Begin DoDot:1
+7 SET RCSCREEN=RCSCREEN_",$E($P($G(^(0)),U,4),1,3)=""OGC"""
End DoDot:1
+8 IF $PIECE(^RCY(344,DA,0),"^",4)=14
Begin DoDot:1
+9 SET RCSCREEN=RCSCREEN_",$E($P($G(^(0)),U,4),1,3)'=""OGC"""
End DoDot:1
+10 ;
+11 ;PRCA*4.5*409 End
G1 SET Y=$$ASKEFT^RCDPEU2(RCPROMPT,RCSCREEN)
+1 IF Y=-1
QUIT 0
+2 IF Y=0
Begin DoDot:1
+3 WRITE !,*7,"Must have an EFT for an EDI Lockbox payment type"
End DoDot:1
GOTO G1
+4 ; END - PRCA*4.5*326
+5 QUIT Y
+6 ;
EFTKEY() ;Check if user has UNMATCH EFT key
+1 ; Input: None
+2 ; Returns; 1 if user owns RCDPEPP key ; otherwise 0.
+3 NEW MSG
+4 DO OWNSKEY^XUSRB(.MSG,"RCDPEPP",DUZ)
+5 QUIT MSG(0)
+6 ;
EFTUPD(DA,MATCH) ; Update EFT record if payment type is changed
+1 ; Input: DA = Internal entry number of EFT record.
+2 ; MATCH = New match status for the EFT
+3 ; Output: Notification to user screen, RCMSG.
+4 NEW DIE,DIR,DR,RCMSG,X,Y
+5 SET DIE="^RCY(344.31,"
+6 IF DA
SET DR=".08////"_MATCH
DO ^DIE
+7 ; PRCA*4.5*326
SET Y=$$GET1^DIQ(344.31,DA_",",.01,"E")
+8 ;
IF Y
Begin DoDot:1
+9 SET RCMSG="EFT TRANSACTION "_Y_" updated to "_$$GET1^DIQ(344.31,DA_",",.08,"E")
End DoDot:1
+10 IF '$TEST
SET RCMSG="* EFT RECORD not found! *"
+11 WRITE !," "_RCMSG
+12 QUIT
PAUSE ; Pause screen till user hits enter
+1 ; Input: None
+2 ; output: None
+3 NEW DIR,X,Y
+4 SET DIR(0)="EA"
SET DIR("A")="Press return: "
DO ^DIR
+5 QUIT
+6 ;
DIC19 ;
+1 SET G="^DIC(19)"
FOR
SET G=$QUERY(@G)
if '$PIECE(G,"^DIC(",2)=19
QUIT
IF @G["IDP"
WRITE !,G,!,@G
+2 ;
+3 QUIT
+4 ;
ISCHMPVA(RCTYP) ; Returns whether the given receipt type is CHAMPVA or not
+1 QUIT $PIECE($GET(^RC(341.1,+$GET(RCTYP),0)),U,2)=17
+2 ;
