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

RCDPXPAP.m

Go to the documentation of this file.
  1. RCDPXPAP ;WISC/RFJ-CS automatically process the deposits ;1 Jun 99
  1. ;;4.5;Accounts Receivable;**114,150,206,296,301**;Mar 20, 1995;Build 144
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;PRCA*4.5*301 Add check for valid billing # on CS 170 transactions
  1. ; and create suspense entry if invalid.
  1. ;
  1. PROCESS(RCDPDATE,RCPAYDA) ; process the deposits
  1. ; rcdpdate is the transmission date; rcpayda is ien for the payment
  1. ; type found in ^rc(341.1,rcpayda)
  1. N DR,PAYDESC,RCDEPDAT,RCDEPOSI,RCDEPTDA,RCDFN,RCDPDATA,RCLINE,RCRECTDA,RCTRANDA,STATUS
  1. K ^TMP($J,"RCDPXPAP")
  1. ;
  1. ; file the data in the payment files 344 (AR BATCH PAYMENT) and 344.1 (AR DEPOSIT)
  1. ; tmp global = acct number(1) ^ amount(2) ^ batch#(3) ^ sequence#(4) ^
  1. ; pay type(5) ^ pay desc fields(6)
  1. S RCDEPOSI="" F S RCDEPOSI=$O(^TMP($J,"RCDPXPAY","DEPOSIT",RCDEPOSI)) Q:RCDEPOSI="" D
  1. . S RCDEPDAT=$G(^TMP($J,"RCDPXPAY","DEPDATE",RCDEPOSI))
  1. . ; *296 - event type 'a' or 't' or 'p' based on the prefix deposit #
  1. . N RCDETY S RCDETY=+$E(RCDEPOSI,1,3)
  1. . S RCPAYDA=$S(RCDETY=168:15,RCDETY=169:13,RCDETY=170:16,1:$G(RCPAYDA))
  1. . ;
  1. . ; add the deposit if not already in file
  1. . ; make sure deposit is 6 characters in length
  1. . S X=$E("000000",1,6-$L(RCDEPOSI))_RCDEPOSI
  1. . S RCDEPTDA=$$ADDDEPT^RCDPUDEP(X,RCDEPDAT)
  1. . I 'RCDEPTDA D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Unable to ADD deposit "_RCDEPOSI_" to the AR DEPOSIT file #344.1") Q
  1. . ;
  1. . ; lock deposit
  1. . L +^RCY(344.1,RCDEPTDA)
  1. . ; confirm deposit (close it to prevent modifications to it)
  1. . D CONFIRM^RCDPUDEP(RCDEPTDA)
  1. . ; store the deposit for unlocking below
  1. . S ^TMP($J,"RCDPXPAP","DEPOSITLOCK",RCDEPTDA)=""
  1. . ;
  1. . ; create receipt for transmission date and deposit
  1. . S RCRECTDA=$$ADDRECT^RCDPUREC(RCDPDATE,RCDEPTDA,RCPAYDA)
  1. . I 'RCRECTDA D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Unable to ADD receipt "_RCDPDATE_" to the AR BATCH PAYMENT file #344") Q
  1. . ;
  1. . ; lock receipt
  1. . L +^RCY(344,RCRECTDA)
  1. . ; check to see if receipt has been processed (fms document)
  1. . D DIQ344^RCDPRPLM(RCRECTDA,"200;")
  1. . ; code sheet already sent once, this is a retransmission, check it
  1. . I RCDPDATA(344,RCRECTDA,200,"E")'="" D
  1. . . S STATUS=$$STATUS^GECSSGET(RCDPDATA(344,RCRECTDA,200,"E"))
  1. . . ; okay to continue if status is Error, Rejected, or not defined (-1)
  1. . . I $E(STATUS)="E"!($E(STATUS)="R")!(STATUS=-1) Q
  1. . . S ^TMP($J,"RCDPXPAP","DUPLICATE",RCRECTDA)="Receipt Not Changed^1"
  1. . I $D(^TMP($J,"RCDPXPAP","DUPLICATE",RCRECTDA)) L -^RCY(344,RCRECTDA) Q
  1. . ;
  1. . ; mark receipt as processed (closed) to prevent editing
  1. . D MARKPROC^RCDPUREC(RCRECTDA,"")
  1. . ; store the receipt for automatic processing (and unlock) below
  1. . ; the 0 is the count of unlinked accts displayed in mail message
  1. . S ^TMP($J,"RCDPXPAP","PROCESS",RCRECTDA)=0
  1. . ;
  1. . ; build a list of the current stored payments by batch_sequence
  1. . ; number to prevent adding duplicates
  1. . K ^TMP($J,"RCDPXPAP",RCRECTDA)
  1. . S RCLINE=0 F S RCLINE=$O(^RCY(344,RCRECTDA,1,RCLINE)) Q:'RCLINE D
  1. . . S RCDPDATA=$G(^RCY(344,RCRECTDA,1,RCLINE,2))
  1. . . I '$P(RCDPDATA,"^",2)!('$P(RCDPDATA,"^",3)) Q
  1. . . S ^TMP($J,"RCDPXPAP",RCRECTDA,$P(RCDPDATA,"^",2),$P(RCDPDATA,"^",3))=RCLINE
  1. . ;
  1. . ; loop transactions and add them to the receipt
  1. . S RCLINE=0 F S RCLINE=$O(^TMP($J,"RCDPXPAY","DEPOSIT",RCDEPOSI,RCLINE)) Q:'RCLINE D
  1. . . ; data in the form:
  1. . . ; acct lookup(1) ^ amount(2) ^ batch(3) ^ sequence(4) ^
  1. . . ; payment type(5) ^ payment description(6)
  1. . . S RCDPDATA=^TMP($J,"RCDPXPAY","DEPOSIT",RCDEPOSI,RCLINE)
  1. . . ; if batch and sequence number already stored get current entry
  1. . . ; and do not add a new one
  1. . . S RCTRANDA=0
  1. . . I $P(RCDPDATA,"^",3),$P(RCDPDATA,"^",4) S RCTRANDA=+$G(^TMP($J,"RCDPXPAP",RCRECTDA,+$P(RCDPDATA,"^",3),+$P(RCDPDATA,"^",4)))
  1. . . I 'RCTRANDA S RCTRANDA=+$$ADDTRAN^RCDPURET(RCRECTDA)
  1. . . I 'RCTRANDA D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Unable to ADD a new transaction to the AR BATCH PAYMENT file #344") Q
  1. . . ;
  1. . . ; if the entry has already been processed, do not make any changes
  1. . . I $P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",5) S:'$D(^TMP($J,"RCDPXPAP","DUPLICATE",RCRECTDA)) ^(RCRECTDA)="Receipt Not Changed" Q
  1. . . I $D(^TMP($J,"RCDPXPAP","DUPLICATE",RCRECTDA)) S ^(RCRECTDA)="Receipt Updated"
  1. . . ;
  1. . . ; lookup account
  1. . . S RCDFN=$$FINDACCT($P(RCDPDATA,"^"))_";DPT("
  1. . . ; acct not found, count as unlinked for mail message
  1. . . I 'RCDFN S ^TMP($J,"RCDPXPAP","PROCESS",RCRECTDA)=^TMP($J,"RCDPXPAP","PROCESS",RCRECTDA)+1
  1. . . ;
  1. . . ; build dr string to store the data
  1. . . S DR=".21////"_$P(RCDPDATA,"^")_";" ;account
  1. . . I RCDFN S DR=DR_".03////^S X=RCDFN;.09////^S X=RCDFN;"
  1. . . S DR=DR_".22////"_+$P(RCDPDATA,"^",3)_";" ;batch number
  1. . . S DR=DR_".23////"_+$P(RCDPDATA,"^",4)_";" ;sequence number
  1. . . S DR=DR_".24////"_$P(RCDPDATA,"^",5)_";" ;payment type
  1. . . S DR=DR_".04////"_($P(RCDPDATA,"^",2)/100)_";" ;payment amount
  1. . . S DR=DR_".06////"_RCDEPDAT_";" ;payment date = deposit date
  1. . . ;
  1. . . S PAYDESC=$P(RCDPDATA,"^",6)
  1. . . ; payment type check
  1. . . I $P(RCDPDATA,"^",5)=2 D
  1. . . . ; check number : account number : bank routing number
  1. . . . I $P(PAYDESC,":")'="" S DR=DR_".07////"_$P(PAYDESC,":")_";"
  1. . . . I $P(PAYDESC,":",2)'="" S DR=DR_".13////"_$P(PAYDESC,":",2)_";"
  1. . . . I $P(PAYDESC,":",3)'="" S DR=DR_".08////"_$P(PAYDESC,":",3)_";"
  1. . . ; payment type credit, store credit card number
  1. . . I $P(RCDPDATA,"^",5)=3,$P(PAYDESC,":")'="" S DR=DR_".11////"_$P(PAYDESC,":")_";"
  1. . . ;
  1. . . ; store the payment under the receipt
  1. . . D FILETRAN(RCRECTDA,RCTRANDA,DR)
  1. . . S $P(^RCY(344,RCRECTDA,1,RCTRANDA,0),"^",19)=$P(RCDPDATA,"^",7) ;PRCA*4.5*301
  1. ;
  1. ; automatically process the receipts added
  1. ; ^tmp($j,"rcdpxpap","process",receiptda)=""
  1. S RCRECTDA=0 F S RCRECTDA=$O(^TMP($J,"RCDPXPAP","PROCESS",RCRECTDA)) Q:'RCRECTDA D
  1. . D PROCESS^RCDPURE1(RCRECTDA,0)
  1. . ; clear the lock (set above)
  1. . L -^RCY(344,RCRECTDA)
  1. ;
  1. ; clear all locked deposits
  1. S RCDEPTDA=0 F S RCDEPTDA=$O(^TMP($J,"RCDPXPAP","DEPOSITLOCK",RCDEPTDA)) Q:'RCDEPTDA D
  1. . ; confirm deposit (recalc totals)
  1. . D CONFIRM^RCDPUDEP(RCDEPTDA)
  1. . L -^RCY(344.1,RCDEPTDA)
  1. ;
  1. ; send a message to the users showing what was processed
  1. D PROCMSG^RCDPXPAM
  1. ;
  1. ; need to delete the 344.2 entry
  1. D DELETRAN^RCDPXPA1(RCDPDATE)
  1. ;
  1. K ^TMP($J,"RCDPXPAP")
  1. Q
  1. ;
  1. ;
  1. FINDACCT(ACCT) ; lookup the patient and return the dfn
  1. ; if more than one patient matches acct, return null
  1. ; acct in the form 123456789ABCDE
  1. ; *296 - punctuation added to not process the acct in 9n1.5ap
  1. I ACCT'?9N1.5AP D Q DFN
  1. . S DFN=+ACCT I $G(^DPT(DFN,0))'="" Q
  1. . S DFN=$E(DFN,1,10)_"."_$E(DFN,11,99) I $G(^DPT(DFN,0))'="" Q
  1. . S DFN=0
  1. . ;
  1. N COUNT,DFN,FOUND,NAME,SSN
  1. S SSN=$E(ACCT,1,9),NAME=$E(ACCT,10,99)
  1. I SSN="" Q 0
  1. S NAME=$TR(NAME,"/","'")
  1. S COUNT=0 ;used to count number of matches
  1. S FOUND=0 ;used to store matching acct's DFN number
  1. S DFN=0 F S DFN=$O(^DPT("SSN",SSN,DFN)) Q:'DFN I $E($TR($P($G(^DPT(DFN,0)),"^")," "),1,$L(NAME))=NAME S COUNT=COUNT+1,FOUND=DFN
  1. ; multiple acct matches, return null
  1. I COUNT>1 Q 0
  1. ; acct found, return dfn of account which matches
  1. I FOUND D:$G(RCDETY)=170 CHK170 Q FOUND ;PRCA*4.5*301
  1. ;
  1. ; *296 - remove spaces, periods, apostrophes, dashes from the name for treasury/c&p deposits
  1. ; lookup the first 3 chars in the last name for c&p
  1. I $G(RCDETY)=168 S NAME=$E(NAME,3,5)
  1. S NAME=$TR(NAME," .'-")
  1. S DFN=0 F S DFN=$O(^DPT("SSN",SSN,DFN)) Q:'DFN I $E($TR($P($G(^DPT(DFN,0)),"^")," .'-"),1,$L(NAME))=NAME S COUNT=COUNT+1,FOUND=DFN
  1. ; multiple acct matches, return null
  1. I COUNT>1 Q 0
  1. ; return dfn of account which matches, or 0 if not found
  1. I +FOUND,$G(RCDETY)=170 D CHK170
  1. Q +FOUND
  1. ;
  1. CHK170 ;CHECK CS TX 170 FOR VALID BILL NUMER ;PRCA*4.5*301
  1. S PRCABIL1=$E($P(RCDPDATA,"^",6),1,3)_"-"_$E($P(RCDPDATA,"^",6),4,10)
  1. S PRCABIL2=$O(^PRCA(430,"B",PRCABIL1,0)) I 'PRCABIL2 S FOUND=0 Q
  1. S PRCABIL2=$P(^PRCA(430,PRCABIL2,0),"^",9)
  1. I +$G(^RCD(340,PRCABIL2,0))'=+FOUND S FOUND=0
  1. Q
  1. ;
  1. FILETRAN(RECTDA,TRANDA,DR) ; file the payment transaction
  1. N %,D,D0,D1,DA,DI,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,X,Y
  1. S (DIC,DIE)="^RCY(344,"_RECTDA_",1,"
  1. S DA=TRANDA,DA(1)=RECTDA
  1. D ^DIE
  1. Q
  1. ;