- 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 Jan 18, 2025@02:47:49 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 ;