RCDPXPAY ;WISC/RFJ-server top to receive electronic payments ;1 Jun 99
;;4.5;Accounts Receivable;**114,148,150,301**;Mar 20, 1995;Build 144
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
START ; start receiving message
N RCDPCNTL,RCDPCSUM,RCDPDATA,RCDPDATE,RCDPFLAG,RCDPFSUM,RCDPLIDA,RCDPLINE,RCDPNEXT,RCDPSEQ,RCDPSITE,RCDPTOTL,RCDPXMZ,X,Y,RCBETYPE
K ^TMP($J,"RCDPXPAY") S U="^"
;
; not a valid mail message
I '$D(^XMB(3.9,XMZ,0)) Q
;
S RCDPXMZ=XMZ
; find line 1 of data and make sure it is correctly formatted
S RCDPLINE=.99 F S RCDPLINE=$O(^XMB(3.9,RCDPXMZ,2,RCDPLINE)) Q:'RCDPLINE S RCDPDATA=^(RCDPLINE,0) I $E(RCDPDATA,1,2)="RT" Q
; first 2 characters of line 1 must equal RT
I $E($G(RCDPDATA),1,2)'="RT" D ERROR^RCDPXPAM("",RCDPXMZ,"RT expected (line 1, piece 1)"),COMPLETE Q
; check the station number
S RCDPSITE=$$SITE^RCMSITE
I $P(RCDPDATA,"^",4)'=RCDPSITE D ERROR^RCDPXPAM("",RCDPXMZ,"Wrong station number (line 1, piece 4), station number should be "_RCDPSITE),COMPLETE Q
; get the transmission date and convert it to a fileman date
S RCDPDATE=$$CONVDATE($P(RCDPDATA,"^",8)) I RCDPDATE<0 D ERROR^RCDPXPAM("",RCDPXMZ,"Invalid transmission date (line 1, piece 8)"),COMPLETE Q
; get the sequence number
S RCDPSEQ=+$P(RCDPDATA,"^",2) I 'RCDPSEQ D ERROR^RCDPXPAM("",RCDPXMZ,"Sequence number of the message is missing (line 1, piece 2)"),COMPLETE Q
;
; check for zero payments on message
; sequence=1 ,total sequence=1 ,no payments ,no dollars on RT ,no total dollars
I +$P(RCDPDATA,"^",2)=1,+$P(RCDPDATA,"^",3)=1,'$P(RCDPDATA,"^",5),'$P(RCDPDATA,"^",6),'$P(RCDPDATA,"^",7) D ZEROMSG^RCDPXPAM($P(RCDPDATA,"^",8)) Q
;
; stay and wait for lock to clear
L +^RCY(344.2,RCDPDATE)
;
; check for duplicate message, only store/process the first one
; still go and check to see if all messages have been received and can be processed
I $D(^RCY(344.2,RCDPDATE,1,RCDPSEQ,0)) D DUPLCATE^RCDPXPAM(RCDPDATE,RCDPSEQ,RCDPXMZ),STARPROC Q
;
; add transmission date if not in file
I '$$ADDTRAN^RCDPXPA1(RCDPDATE) D ERROR^RCDPXPAM("",RCDPXMZ,"Unable to add transmission to AR PAYMENT TRANSACTIONS file 344.2"),COMPLETE Q
; store total sequences and dollars if available for transmission
D TRANDOLL^RCDPXPA1(RCDPDATE,+$P(RCDPDATA,"^",3),+$P(RCDPDATA,"^",7)/100)
;
; add the sequence to the transmission multiple
S RCDPSEQ=$$ADDSEQ^RCDPXPA1(RCDPDATE,+$P(RCDPDATA,"^",2)) I 'RCDPSEQ D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Unable to add the sequence number (line 1, piece 2)"),COMPLETE Q
; store number of transactions, total dollars for the sequence, mail message number
D SEQUDOLL^RCDPXPA1(RCDPDATE,RCDPSEQ,+$P(RCDPDATA,"^",5),+$P(RCDPDATA,"^",6)/100,RCDPXMZ)
;
; once the sequence has been added, future errors must pass the
; variable rcdpdate to the label error to set the status to error
; and prevent further processing later on.
;
; store control header line 1 for comparing count and dollars of transactions
S RCDPCNTL=RCDPDATA
;
; loop transactions and store the data
S RCDPCSUM=0 ;used to compute checksum for sequence
S RCDPLIDA=0 ;used to count entries stored in the data wp field
S RCDPTOTL=0 ;used to total all payments (transactions)
TXSET F S RCDPLINE=$O(^XMB(3.9,RCDPXMZ,2,RCDPLINE)) Q:'RCDPLINE D
. S RCDPDATA=^XMB(3.9,RCDPXMZ,2,RCDPLINE,0)
. I RCDPDATA=""!($E(RCDPDATA,1,4)="NNNN") Q
. ; convert deposit date to fm
. S $P(RCDPDATA,"^",7)=$$CONVDATE($P(RCDPDATA,"^",7))
. I $P(RCDPDATA,"^",7)<0 S $P(RCDPDATA,"^",7)=0
. ; check for errors
. I $E(RCDPDATA,1,2)'="RD" S ^TMP($J,"RCDPXPAY","ERROR",RCDPLINE)="RD expected (line "_RCDPLINE_", piece 1)"
. I '$P(RCDPDATA,"^",3) S ^TMP($J,"RCDPXPAY","ERROR",RCDPLINE)="No payment amount (line "_RCDPLINE_", piece 3)"
. I $P(RCDPDATA,"^",6)="" S ^TMP($J,"RCDPXPAY","ERROR",RCDPLINE)="Deposit/215 number missing (line "_RCDPLINE_", piece 6)"
. I '$P(RCDPDATA,"^",7) S ^TMP($J,"RCDPXPAY","ERROR",RCDPLINE)="Deposit date missing/invalid format (line "_RCDPLINE_", piece 7)"
. ; add up dollars
. S RCDPTOTL=RCDPTOTL+($P(RCDPDATA,"^",3)/100)
. ; remove RT, remove station number from account (based on site length)
. ; since the station number is variable 3 to 5 characters
. S RCDPDATA=$P(RCDPDATA,"^",2,99),RCDPDATA=$E(RCDPDATA,$L(RCDPSITE)+1,99999),$P(RCDPDATA,"^",9)=$E($P(RCDPDATA,"^",5),1,3) ;PRCA*4.5*301
. ; store the data
. S RCDPLIDA=RCDPLIDA+1
. S ^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,RCDPLIDA,0)=RCDPDATA
. ; compute checksum
. S X=RCDPCSUM_RCDPDATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S RCDPCSUM=Y
;
; store 0th node with count of lines and date
S ^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,0)="^^"_RCDPLIDA_"^"_RCDPLIDA_"^"_DT_"^"
; store the checksum for sequence
D TRANCSUM^RCDPXPA1(RCDPDATE,RCDPSEQ,RCDPCSUM)
;
; check number of transactions for sequence
I $P(RCDPCNTL,"^",5)'=RCDPLIDA D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Expected number of transactions not equal actual number (line 1, piece 5)"),COMPLETE Q
; check total dollars for sequence
I ($P(RCDPCNTL,"^",6)/100)'=RCDPTOTL D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Expected dollars of transactions not equal actual dollars (line 1, piece 6)"),COMPLETE Q
;
; if errors on rd lines, stop process
I $O(^TMP($J,"RCDPXPAY","ERROR",0)) D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,""),COMPLETE Q
;
STARPROC ; start processing
; check to see if all messages (sequences) have been received
S RCDPFLAG=1
S RCDPDATA=^RCY(344.2,RCDPDATE,0) I $P(RCDPDATA,"^",2) D
. S RCDPFLAG=0
. F RCDPSEQ=1:1:$P(RCDPDATA,"^",2) I '$D(^RCY(344.2,RCDPDATE,1,RCDPSEQ)) S RCDPFLAG=1 Q
; not all sequences received yet
I $G(RCDPFLAG) D COMPLETE Q
;
; ***** all sequences received, start processing *****
; if status is error, quit and wait for tomorrow to send retransmission
; message to mail group
I $P(^RCY(344.2,RCDPDATE,0),"^",4)="e" D COMPLETE Q
; already processing/processed the payments
I $P(^RCY(344.2,RCDPDATE,0),"^",4)="p" D COMPLETE Q
;
; set status to processing
D TRANSTAT^RCDPXPA1(RCDPDATE,"p")
S RCDPTOTL=0
S RCDPNEXT=0 ;used for making tmp global entry unique
SETTMP F RCDPSEQ=1:1 Q:'$D(^RCY(344.2,RCDPDATE,1,RCDPSEQ)) D
. S RCDPCSUM=0
. S RCDPTOTL=RCDPTOTL+$P(^RCY(344.2,RCDPDATE,1,RCDPSEQ,0),"^",3)
. F RCDPLIDA=1:1 Q:'$D(^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,RCDPLIDA,0)) D
. . S RCDPDATA=^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,RCDPLIDA,0)
. . ; compute checksum
. . S X=RCDPCSUM_RCDPDATA X $S($G(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""") S RCDPCSUM=Y
. . ; store transaction for processing
. . ; the deposit number and date should not be null unless the
. . ; data was modified after receipt
. . I $P(RCDPDATA,"^",5)="" S $P(RCDPDATA,"^",5)=" " ; deposit number
. . S RCDPNEXT=RCDPNEXT+1,^TMP($J,"RCDPXPAY","DEPOSIT",$P(RCDPDATA,"^",5),RCDPNEXT)=$P(RCDPDATA,"^",1,4)_"^"_$P(RCDPDATA,"^",7,99)
. . ; save original data for posting & suspense considerations PRCA*4.5*301 BB
. . ; store deposit date for deposit if it is needed
. . I $P(RCDPDATA,"^",6),'$G(^TMP($J,"RCDPXPAY","DEPDATE",$P(RCDPDATA,"^",5))) S ^TMP($J,"RCDPXPAY","DEPDATE",$P(RCDPDATA,"^",5))=$P(RCDPDATA,"^",6)
. ; verify checksum
. I $P(^RCY(344.2,RCDPDATE,1,RCDPSEQ,0),"^",5)'=RCDPCSUM S RCDPFSUM=1
;
; verify totals for all sequences
I $P(^RCY(344.2,RCDPDATE,0),"^",3)'=RCDPTOTL D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"The total dollars for all sequences do not balance with expected total"),COMPLETE Q
; checksum error
I $G(RCDPFSUM) D ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"The deposit information has been altered before processing occured"),COMPLETE Q
;
; everything checks out, start processing
; modify the lockbox lookup for accepting payment from other systems
D PROCESS^RCDPXPAP(RCDPDATE,$O(^RC(341.1,"B","LOCKBOX",0)))
;
COMPLETE ; complete the process
; check for errors in the transmission file for prior dates
; if they exist, mail a message to the users asking for retrans
; remove the entries
N DATA,DEPDATE,DEPOSIT,RCDPDA
S RCDPDA=DT F S RCDPDA=$O(^RCY(344.2,RCDPDA),-1) Q:'RCDPDA D
. ; if the status was last updated today, do not modify
. I $P(^RCY(344.2,RCDPDA,0),"^",5)=DT Q
. ; try and find deposit number and deposit date
. S (DEPOSIT,DEPDATE)="",RCDPFLAG=0
. F RCDPSEQ=1:1 Q:'$D(^RCY(344.2,RCDPDA,1,RCDPSEQ)) D Q:RCDPFLAG
. . F RCDPLIDA=1:1 Q:'$D(^RCY(344.2,RCDPDA,1,RCDPSEQ,1,RCDPLIDA,0)) D Q:RCDPFLAG
. . . S DATA=$G(^RCY(344.2,RCDPDA,1,RCDPSEQ,1,RCDPLIDA,0))
. . . I $P(DATA,"^",5)'="" S DEPOSIT=$P(DATA,"^",5)
. . . I $P(DATA,"^",6)'="" S DEPDATE=$P(DATA,"^",6)
. . . I DEPOSIT'="",DEPDATE'="" S RCDPFLAG=1 ; used to stop for loops
. ;
. S ^TMP($J,"RCDPXPAY","RETRAN",RCDPDA)=DEPOSIT_"^"_DEPDATE_"^"_$P(^RCY(344.2,RCDPDA,0),"^",4)
. ; remove the entry from the file so it will not appear later
. D DELETRAN^RCDPXPA1(RCDPDA)
; if there are any, send a message asking for retransmission
I $O(^TMP($J,"RCDPXPAY","RETRAN",0)) D RETRAN^RCDPXPAM
;
; clear the current transmission date lock, clear it here to prevent
; two processes from sending the retransmission request message
I $G(RCDPDATE) L -^RCY(344.2,RCDPDATE)
;
; clean up
K ^TMP($J,"RCDPXPAY")
;
; remove message from server basket
N K,X,XMK,XMSER,Y
S XMSER="S.RCDP AUTOMATIC PAYMENTS",XMZ=RCDPXMZ
D REMSBMSG^XMA1C
Q
;
;
CONVDATE(DATE) ; convert date from mmddyyyy to fm date cyymmdd
Q ($E(DATE,5,6)-17)_$E(DATE,7,8)_$E(DATE,1,2)_$E(DATE,3,4)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPXPAY 9768 printed Oct 16, 2024@17:47:35 Page 2
RCDPXPAY ;WISC/RFJ-server top to receive electronic payments ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148,150,301**;Mar 20, 1995;Build 144
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
START ; start receiving message
+1 NEW RCDPCNTL,RCDPCSUM,RCDPDATA,RCDPDATE,RCDPFLAG,RCDPFSUM,RCDPLIDA,RCDPLINE,RCDPNEXT,RCDPSEQ,RCDPSITE,RCDPTOTL,RCDPXMZ,X,Y,RCBETYPE
+2 KILL ^TMP($JOB,"RCDPXPAY")
SET U="^"
+3 ;
+4 ; not a valid mail message
+5 IF '$DATA(^XMB(3.9,XMZ,0))
QUIT
+6 ;
+7 SET RCDPXMZ=XMZ
+8 ; find line 1 of data and make sure it is correctly formatted
+9 SET RCDPLINE=.99
FOR
SET RCDPLINE=$ORDER(^XMB(3.9,RCDPXMZ,2,RCDPLINE))
if 'RCDPLINE
QUIT
SET RCDPDATA=^(RCDPLINE,0)
IF $EXTRACT(RCDPDATA,1,2)="RT"
QUIT
+10 ; first 2 characters of line 1 must equal RT
+11 IF $EXTRACT($GET(RCDPDATA),1,2)'="RT"
DO ERROR^RCDPXPAM("",RCDPXMZ,"RT expected (line 1, piece 1)")
DO COMPLETE
QUIT
+12 ; check the station number
+13 SET RCDPSITE=$$SITE^RCMSITE
+14 IF $PIECE(RCDPDATA,"^",4)'=RCDPSITE
DO ERROR^RCDPXPAM("",RCDPXMZ,"Wrong station number (line 1, piece 4), station number should be "_RCDPSITE)
DO COMPLETE
QUIT
+15 ; get the transmission date and convert it to a fileman date
+16 SET RCDPDATE=$$CONVDATE($PIECE(RCDPDATA,"^",8))
IF RCDPDATE<0
DO ERROR^RCDPXPAM("",RCDPXMZ,"Invalid transmission date (line 1, piece 8)")
DO COMPLETE
QUIT
+17 ; get the sequence number
+18 SET RCDPSEQ=+$PIECE(RCDPDATA,"^",2)
IF 'RCDPSEQ
DO ERROR^RCDPXPAM("",RCDPXMZ,"Sequence number of the message is missing (line 1, piece 2)")
DO COMPLETE
QUIT
+19 ;
+20 ; check for zero payments on message
+21 ; sequence=1 ,total sequence=1 ,no payments ,no dollars on RT ,no total dollars
+22 IF +$PIECE(RCDPDATA,"^",2)=1
IF +$PIECE(RCDPDATA,"^",3)=1
IF '$PIECE(RCDPDATA,"^",5)
IF '$PIECE(RCDPDATA,"^",6)
IF '$PIECE(RCDPDATA,"^",7)
DO ZEROMSG^RCDPXPAM($PIECE(RCDPDATA,"^",8))
QUIT
+23 ;
+24 ; stay and wait for lock to clear
+25 LOCK +^RCY(344.2,RCDPDATE)
+26 ;
+27 ; check for duplicate message, only store/process the first one
+28 ; still go and check to see if all messages have been received and can be processed
+29 IF $DATA(^RCY(344.2,RCDPDATE,1,RCDPSEQ,0))
DO DUPLCATE^RCDPXPAM(RCDPDATE,RCDPSEQ,RCDPXMZ)
DO STARPROC
QUIT
+30 ;
+31 ; add transmission date if not in file
+32 IF '$$ADDTRAN^RCDPXPA1(RCDPDATE)
DO ERROR^RCDPXPAM("",RCDPXMZ,"Unable to add transmission to AR PAYMENT TRANSACTIONS file 344.2")
DO COMPLETE
QUIT
+33 ; store total sequences and dollars if available for transmission
+34 DO TRANDOLL^RCDPXPA1(RCDPDATE,+$PIECE(RCDPDATA,"^",3),+$PIECE(RCDPDATA,"^",7)/100)
+35 ;
+36 ; add the sequence to the transmission multiple
+37 SET RCDPSEQ=$$ADDSEQ^RCDPXPA1(RCDPDATE,+$PIECE(RCDPDATA,"^",2))
IF 'RCDPSEQ
DO ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Unable to add the sequence number (line 1, piece 2)")
DO COMPLETE
QUIT
+38 ; store number of transactions, total dollars for the sequence, mail message number
+39 DO SEQUDOLL^RCDPXPA1(RCDPDATE,RCDPSEQ,+$PIECE(RCDPDATA,"^",5),+$PIECE(RCDPDATA,"^",6)/100,RCDPXMZ)
+40 ;
+41 ; once the sequence has been added, future errors must pass the
+42 ; variable rcdpdate to the label error to set the status to error
+43 ; and prevent further processing later on.
+44 ;
+45 ; store control header line 1 for comparing count and dollars of transactions
+46 SET RCDPCNTL=RCDPDATA
+47 ;
+48 ; loop transactions and store the data
+49 ;used to compute checksum for sequence
SET RCDPCSUM=0
+50 ;used to count entries stored in the data wp field
SET RCDPLIDA=0
+51 ;used to total all payments (transactions)
SET RCDPTOTL=0
TXSET FOR
SET RCDPLINE=$ORDER(^XMB(3.9,RCDPXMZ,2,RCDPLINE))
if 'RCDPLINE
QUIT
Begin DoDot:1
+1 SET RCDPDATA=^XMB(3.9,RCDPXMZ,2,RCDPLINE,0)
+2 IF RCDPDATA=""!($EXTRACT(RCDPDATA,1,4)="NNNN")
QUIT
+3 ; convert deposit date to fm
+4 SET $PIECE(RCDPDATA,"^",7)=$$CONVDATE($PIECE(RCDPDATA,"^",7))
+5 IF $PIECE(RCDPDATA,"^",7)<0
SET $PIECE(RCDPDATA,"^",7)=0
+6 ; check for errors
+7 IF $EXTRACT(RCDPDATA,1,2)'="RD"
SET ^TMP($JOB,"RCDPXPAY","ERROR",RCDPLINE)="RD expected (line "_RCDPLINE_", piece 1)"
+8 IF '$PIECE(RCDPDATA,"^",3)
SET ^TMP($JOB,"RCDPXPAY","ERROR",RCDPLINE)="No payment amount (line "_RCDPLINE_", piece 3)"
+9 IF $PIECE(RCDPDATA,"^",6)=""
SET ^TMP($JOB,"RCDPXPAY","ERROR",RCDPLINE)="Deposit/215 number missing (line "_RCDPLINE_", piece 6)"
+10 IF '$PIECE(RCDPDATA,"^",7)
SET ^TMP($JOB,"RCDPXPAY","ERROR",RCDPLINE)="Deposit date missing/invalid format (line "_RCDPLINE_", piece 7)"
+11 ; add up dollars
+12 SET RCDPTOTL=RCDPTOTL+($PIECE(RCDPDATA,"^",3)/100)
+13 ; remove RT, remove station number from account (based on site length)
+14 ; since the station number is variable 3 to 5 characters
+15 ;PRCA*4.5*301
SET RCDPDATA=$PIECE(RCDPDATA,"^",2,99)
SET RCDPDATA=$EXTRACT(RCDPDATA,$LENGTH(RCDPSITE)+1,99999)
SET $PIECE(RCDPDATA,"^",9)=$EXTRACT($PIECE(RCDPDATA,"^",5),1,3)
+16 ; store the data
+17 SET RCDPLIDA=RCDPLIDA+1
+18 SET ^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,RCDPLIDA,0)=RCDPDATA
+19 ; compute checksum
+20 SET X=RCDPCSUM_RCDPDATA
XECUTE $SELECT($GET(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""")
SET RCDPCSUM=Y
End DoDot:1
+21 ;
+22 ; store 0th node with count of lines and date
+23 SET ^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,0)="^^"_RCDPLIDA_"^"_RCDPLIDA_"^"_DT_"^"
+24 ; store the checksum for sequence
+25 DO TRANCSUM^RCDPXPA1(RCDPDATE,RCDPSEQ,RCDPCSUM)
+26 ;
+27 ; check number of transactions for sequence
+28 IF $PIECE(RCDPCNTL,"^",5)'=RCDPLIDA
DO ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Expected number of transactions not equal actual number (line 1, piece 5)")
DO COMPLETE
QUIT
+29 ; check total dollars for sequence
+30 IF ($PIECE(RCDPCNTL,"^",6)/100)'=RCDPTOTL
DO ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"Expected dollars of transactions not equal actual dollars (line 1, piece 6)")
DO COMPLETE
QUIT
+31 ;
+32 ; if errors on rd lines, stop process
+33 IF $ORDER(^TMP($JOB,"RCDPXPAY","ERROR",0))
DO ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"")
DO COMPLETE
QUIT
+34 ;
STARPROC ; start processing
+1 ; check to see if all messages (sequences) have been received
+2 SET RCDPFLAG=1
+3 SET RCDPDATA=^RCY(344.2,RCDPDATE,0)
IF $PIECE(RCDPDATA,"^",2)
Begin DoDot:1
+4 SET RCDPFLAG=0
+5 FOR RCDPSEQ=1:1:$PIECE(RCDPDATA,"^",2)
IF '$DATA(^RCY(344.2,RCDPDATE,1,RCDPSEQ))
SET RCDPFLAG=1
QUIT
End DoDot:1
+6 ; not all sequences received yet
+7 IF $GET(RCDPFLAG)
DO COMPLETE
QUIT
+8 ;
+9 ; ***** all sequences received, start processing *****
+10 ; if status is error, quit and wait for tomorrow to send retransmission
+11 ; message to mail group
+12 IF $PIECE(^RCY(344.2,RCDPDATE,0),"^",4)="e"
DO COMPLETE
QUIT
+13 ; already processing/processed the payments
+14 IF $PIECE(^RCY(344.2,RCDPDATE,0),"^",4)="p"
DO COMPLETE
QUIT
+15 ;
+16 ; set status to processing
+17 DO TRANSTAT^RCDPXPA1(RCDPDATE,"p")
+18 SET RCDPTOTL=0
+19 ;used for making tmp global entry unique
SET RCDPNEXT=0
SETTMP FOR RCDPSEQ=1:1
if '$DATA(^RCY(344.2,RCDPDATE,1,RCDPSEQ))
QUIT
Begin DoDot:1
+1 SET RCDPCSUM=0
+2 SET RCDPTOTL=RCDPTOTL+$PIECE(^RCY(344.2,RCDPDATE,1,RCDPSEQ,0),"^",3)
+3 FOR RCDPLIDA=1:1
if '$DATA(^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,RCDPLIDA,0))
QUIT
Begin DoDot:2
+4 SET RCDPDATA=^RCY(344.2,RCDPDATE,1,RCDPSEQ,1,RCDPLIDA,0)
+5 ; compute checksum
+6 SET X=RCDPCSUM_RCDPDATA
XECUTE $SELECT($GET(^%ZOSF("LPC"))'="":^("LPC"),1:"S Y=""""")
SET RCDPCSUM=Y
+7 ; store transaction for processing
+8 ; the deposit number and date should not be null unless the
+9 ; data was modified after receipt
+10 ; deposit number
IF $PIECE(RCDPDATA,"^",5)=""
SET $PIECE(RCDPDATA,"^",5)=" "
+11 SET RCDPNEXT=RCDPNEXT+1
SET ^TMP($JOB,"RCDPXPAY","DEPOSIT",$PIECE(RCDPDATA,"^",5),RCDPNEXT)=$PIECE(RCDPDATA,"^",1,4)_"^"_$PIECE(RCDPDATA,"^",7,99)
+12 ; save original data for posting & suspense considerations PRCA*4.5*301 BB
+13 ; store deposit date for deposit if it is needed
+14 IF $PIECE(RCDPDATA,"^",6)
IF '$GET(^TMP($JOB,"RCDPXPAY","DEPDATE",$PIECE(RCDPDATA,"^",5)))
SET ^TMP($JOB,"RCDPXPAY","DEPDATE",$PIECE(RCDPDATA,"^",5))=$PIECE(RCDPDATA,"^",6)
End DoDot:2
+15 ; verify checksum
+16 IF $PIECE(^RCY(344.2,RCDPDATE,1,RCDPSEQ,0),"^",5)'=RCDPCSUM
SET RCDPFSUM=1
End DoDot:1
+17 ;
+18 ; verify totals for all sequences
+19 IF $PIECE(^RCY(344.2,RCDPDATE,0),"^",3)'=RCDPTOTL
DO ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"The total dollars for all sequences do not balance with expected total")
DO COMPLETE
QUIT
+20 ; checksum error
+21 IF $GET(RCDPFSUM)
DO ERROR^RCDPXPAM(RCDPDATE,RCDPXMZ,"The deposit information has been altered before processing occured")
DO COMPLETE
QUIT
+22 ;
+23 ; everything checks out, start processing
+24 ; modify the lockbox lookup for accepting payment from other systems
+25 DO PROCESS^RCDPXPAP(RCDPDATE,$ORDER(^RC(341.1,"B","LOCKBOX",0)))
+26 ;
COMPLETE ; complete the process
+1 ; check for errors in the transmission file for prior dates
+2 ; if they exist, mail a message to the users asking for retrans
+3 ; remove the entries
+4 NEW DATA,DEPDATE,DEPOSIT,RCDPDA
+5 SET RCDPDA=DT
FOR
SET RCDPDA=$ORDER(^RCY(344.2,RCDPDA),-1)
if 'RCDPDA
QUIT
Begin DoDot:1
+6 ; if the status was last updated today, do not modify
+7 IF $PIECE(^RCY(344.2,RCDPDA,0),"^",5)=DT
QUIT
+8 ; try and find deposit number and deposit date
+9 SET (DEPOSIT,DEPDATE)=""
SET RCDPFLAG=0
+10 FOR RCDPSEQ=1:1
if '$DATA(^RCY(344.2,RCDPDA,1,RCDPSEQ))
QUIT
Begin DoDot:2
+11 FOR RCDPLIDA=1:1
if '$DATA(^RCY(344.2,RCDPDA,1,RCDPSEQ,1,RCDPLIDA,0))
QUIT
Begin DoDot:3
+12 SET DATA=$GET(^RCY(344.2,RCDPDA,1,RCDPSEQ,1,RCDPLIDA,0))
+13 IF $PIECE(DATA,"^",5)'=""
SET DEPOSIT=$PIECE(DATA,"^",5)
+14 IF $PIECE(DATA,"^",6)'=""
SET DEPDATE=$PIECE(DATA,"^",6)
+15 ; used to stop for loops
IF DEPOSIT'=""
IF DEPDATE'=""
SET RCDPFLAG=1
End DoDot:3
if RCDPFLAG
QUIT
End DoDot:2
if RCDPFLAG
QUIT
+16 ;
+17 SET ^TMP($JOB,"RCDPXPAY","RETRAN",RCDPDA)=DEPOSIT_"^"_DEPDATE_"^"_$PIECE(^RCY(344.2,RCDPDA,0),"^",4)
+18 ; remove the entry from the file so it will not appear later
+19 DO DELETRAN^RCDPXPA1(RCDPDA)
End DoDot:1
+20 ; if there are any, send a message asking for retransmission
+21 IF $ORDER(^TMP($JOB,"RCDPXPAY","RETRAN",0))
DO RETRAN^RCDPXPAM
+22 ;
+23 ; clear the current transmission date lock, clear it here to prevent
+24 ; two processes from sending the retransmission request message
+25 IF $GET(RCDPDATE)
LOCK -^RCY(344.2,RCDPDATE)
+26 ;
+27 ; clean up
+28 KILL ^TMP($JOB,"RCDPXPAY")
+29 ;
+30 ; remove message from server basket
+31 NEW K,X,XMK,XMSER,Y
+32 SET XMSER="S.RCDP AUTOMATIC PAYMENTS"
SET XMZ=RCDPXMZ
+33 DO REMSBMSG^XMA1C
+34 QUIT
+35 ;
+36 ;
CONVDATE(DATE) ; convert date from mmddyyyy to fm date cyymmdd
+1 QUIT ($EXTRACT(DATE,5,6)-17)_$EXTRACT(DATE,7,8)_$EXTRACT(DATE,1,2)_$EXTRACT(DATE,3,4)
