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

RCDPUREC.m

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