- 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 Feb 18, 2025@23:13:07 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)