BARUFEX4 ; IHS/SD/TPF - CONTINUATION OF EXPORT -- PAYMENT PROCESSING ;10/31/08
;;1.8;IHS ACCOUNTS RECEIVABLE;**4,8**;NOV 13, 2007
;NEW ROUTINE;ITEM 1 OF SCR58 1/2/2008 ;MRS:BAR*1.8*4 DD ITEM 4.1.1
;
COLCK(BARDUZ) ;EP; CHECK +DOLLAR PAYMENTS ENTRIES IN COLLECTION BATCH FOR REVERSAL PAYMENTS
; ENTERS WITH: BARDUZ= CASHIER
; TRDATE ;TRANSACTION DATE
; ARBILL ;A/R BILL
; ARBILLIN ;A/R BILL IEN
; ARCRDEB ;PAYMENT AMOUNT = +$AMOUNT ONLY
; ARCOLB ;COLLECTION BATCH NAME
; ARCOLITM ;COLLECTION ITEM
; ARCOLIN ;COLLECTION BATCH PTR
; DUZ(2)
;
; RETURNS 0 = NOT OK TO SEND TO UFMS
; 1 = OK TO SEND TO UFMS
;
N BAROK
I '$D(^BARCOL(DUZ(2),ARCOLIN,1,ARCOLITM)) D Q 0 ;NOT OK
ERR24 .D ERR^BARUFEXU(24) ;TX NOT IN BATCH
;
I $G(^BARBOB("BARZ",BARDUZ,DUZ(2),ARCOLIN,ARCOLITM))=1 Q 1 ;NO REVERSALS IN BATCH/ITEM
D LOOP
Q BAROK
;
LOOP ; LOOP THROUGH ^BARBOB("BARZ",DUZ THAT IS SET IN BARUFEX5
; CODE 2 = SIMPLE REVERSALS ARE PAIRED IN BOB
; CODE 1 = COULDN'T FIND ORIGINAL PAYMENT, BUT MADE MATCH IN BATCH/ITEM
; CODE -I = IGNORE--REVERSAL PRECEDES PAYMENT IN BILL AND MATCH IN BATCH/ITEM
; CODES 1,2 are sent to UFMS
; All negative codes are treated as errors and not sent to UFMS
; (CODE -I is currently treated as error; will be coded to ignore -- NO UFMS)
; -25 CODE = DUPLICATE PAYMENT, ERROR ALL OUT
; -6 or -3 = ORIGINAL PAYMENT NOT IN BILL OR BATCH/ITEM, ERROR ALL OUT
; -7 or -4 = MULTIPLE PAYMENTS, ONLY ERROR OUT BILL
;
; IF THE SEARCH FINDS AN UNPAIRED NEGATIVE PAYMENT, BAROK IS ONLY SET TRUE
; WHEN THE SCHEDULE NUMBER AND ABSOLUTE PAYMENT AMOUNTS MATCH
; IF NO NEGATIVE PAYMENT AND THE POSITIVE VALUE ENTRY IS FOUND
; BAROK IS SET TO TRUE
; OTHERWISE, BAROK IS NOT OK, AND A NOT SENT ERROR IS GENERATED
;
N TDATE,TARBILL,TARBILIN,TARCRDB,TARCITM,BAR,TIPAC,TTRAN,ERR,BARFLG
S (TDATE,BARCNT,BARPNEG,BARNEG,ERR)=0
K ERR(0)
S BAROK=0
F S TDATE=$O(^BARBOB("BARZ",BARDUZ,DUZ(2),ARCOLIN,ARCOLITM,TDATE)) Q:'TDATE!($D(ERR(0))) D
.S IENS=TDATE_","
.S BARZ0=^BARBOB("BARZ",BARDUZ,DUZ(2),ARCOLIN,ARCOLITM,TDATE)
.S BARFLG=$P(BARZ0,U,5)
.Q:BARFLG>0!(BARFLG="-I") ;PAIR FLAGGED OK OR IGNORABLE
.S TIPAC=$P(BARZ0,U,2) ;IPAC
.S TCRDEB=$P(BARZ0,U,1) ;CREDIT - DEBIT
.S TARBILIN=$P(BARZ0,U,3) ;A/R BILL PTR
.S TARBILL=$P(BARZ0,U,4) ;A/R BILL NUMBER
.I TCRDEB<0 D ;NEGATIVE ENTRY IN COL BATCH
ERR47 ..I BARFLG=-7!(BARFLG=-4)!(BARFLG=-25) D Q
...I ARBILLIN=TARBILIN S ERR=-BARFLG Q ;ONLY ERROR OUT SAME BILL
ERR36 ..I BARFLG=-6!(BARFLG=-3) S ERR=-BARFLG ;NOT IN BILL, ERROR ALL OUT
..I TIPAC=BARIPAC,(-ARCRDEB=TCRDEB) S BAROK=1 Q ;FOUND THE PAIR
ERR902 ..I TIPAC'=BARIPAC&((-ARCRDEB)=(TCRDEB)) S ERR=9.02
ERR901 ..I TIPAC=BARIPAC&((-ARCRDEB)'=(TCRDEB)) S ERR=9.01
ERR903 ..I 'ERR S ERR=9.03
..S BAR(0)=ERR
I BAROK Q ;FOUND A MATCH
I $D(BAR(0)) D Q
.S BAROK=0
ERR9 .D ERR^BARUFEXU(BAR(0)) ;COMPLEX PAYMENT/REVERSAL IN COLLECTION BATCH
S BAROK=1
Q
;
ERR(MSG) ;NOT SENT ERROR MESSAGE CENTER
;
D ERR^BARUFEXU(MSG)
Q
IPAC(X,Y,IENS) ;EP BAR*1.8*4 DD item 4.1.5.4
S Z=$$GET1^DIQ(90050.03,IENS,17,"E")
I Z'="" Q Z ;FOUND IN TX FILE
;S Z=$P($G(^BARCOL(DUZ(2),X,1,Y,0)),U,20) ;MRS:BAR*1.8*8 D150
S Z=$$GET1^DIQ(90051.1101,Y_","_X_",",20) ;MRS:BAR*1.8*8 D150
S:Z="" Z="PRE-UFMS_COLLECTIONS"
Q Z
BARUFEX4 ; IHS/SD/TPF - CONTINUATION OF EXPORT -- PAYMENT PROCESSING ;10/31/08
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**4,8**;NOV 13, 2007
+2 ;NEW ROUTINE;ITEM 1 OF SCR58 1/2/2008 ;MRS:BAR*1.8*4 DD ITEM 4.1.1
+3 ;
COLCK(BARDUZ) ;EP; CHECK +DOLLAR PAYMENTS ENTRIES IN COLLECTION BATCH FOR REVERSAL PAYMENTS
+1 ; ENTERS WITH: BARDUZ= CASHIER
+2 ; TRDATE ;TRANSACTION DATE
+3 ; ARBILL ;A/R BILL
+4 ; ARBILLIN ;A/R BILL IEN
+5 ; ARCRDEB ;PAYMENT AMOUNT = +$AMOUNT ONLY
+6 ; ARCOLB ;COLLECTION BATCH NAME
+7 ; ARCOLITM ;COLLECTION ITEM
+8 ; ARCOLIN ;COLLECTION BATCH PTR
+9 ; DUZ(2)
+10 ;
+11 ; RETURNS 0 = NOT OK TO SEND TO UFMS
+12 ; 1 = OK TO SEND TO UFMS
+13 ;
+14 NEW BAROK
+15 ;NOT OK
IF '$DATA(^BARCOL(DUZ(2),ARCOLIN,1,ARCOLITM))
Begin DoDot:1
ERR24 ;TX NOT IN BATCH
DO ERR^BARUFEXU(24)
End DoDot:1
QUIT 0
+1 ;
+2 ;NO REVERSALS IN BATCH/ITEM
IF $GET(^BARBOB("BARZ",BARDUZ,DUZ(2),ARCOLIN,ARCOLITM))=1
QUIT 1
+3 DO LOOP
+4 QUIT BAROK
+5 ;
LOOP ; LOOP THROUGH ^BARBOB("BARZ",DUZ THAT IS SET IN BARUFEX5
+1 ; CODE 2 = SIMPLE REVERSALS ARE PAIRED IN BOB
+2 ; CODE 1 = COULDN'T FIND ORIGINAL PAYMENT, BUT MADE MATCH IN BATCH/ITEM
+3 ; CODE -I = IGNORE--REVERSAL PRECEDES PAYMENT IN BILL AND MATCH IN BATCH/ITEM
+4 ; CODES 1,2 are sent to UFMS
+5 ; All negative codes are treated as errors and not sent to UFMS
+6 ; (CODE -I is currently treated as error; will be coded to ignore -- NO UFMS)
+7 ; -25 CODE = DUPLICATE PAYMENT, ERROR ALL OUT
+8 ; -6 or -3 = ORIGINAL PAYMENT NOT IN BILL OR BATCH/ITEM, ERROR ALL OUT
+9 ; -7 or -4 = MULTIPLE PAYMENTS, ONLY ERROR OUT BILL
+10 ;
+11 ; IF THE SEARCH FINDS AN UNPAIRED NEGATIVE PAYMENT, BAROK IS ONLY SET TRUE
+12 ; WHEN THE SCHEDULE NUMBER AND ABSOLUTE PAYMENT AMOUNTS MATCH
+13 ; IF NO NEGATIVE PAYMENT AND THE POSITIVE VALUE ENTRY IS FOUND
+14 ; BAROK IS SET TO TRUE
+15 ; OTHERWISE, BAROK IS NOT OK, AND A NOT SENT ERROR IS GENERATED
+16 ;
+17 NEW TDATE,TARBILL,TARBILIN,TARCRDB,TARCITM,BAR,TIPAC,TTRAN,ERR,BARFLG
+18 SET (TDATE,BARCNT,BARPNEG,BARNEG,ERR)=0
+19 KILL ERR(0)
+20 SET BAROK=0
+21 FOR
SET TDATE=$ORDER(^BARBOB("BARZ",BARDUZ,DUZ(2),ARCOLIN,ARCOLITM,TDATE))
IF 'TDATE!($DATA(ERR(0)))
QUIT
Begin DoDot:1
+22 SET IENS=TDATE_","
+23 SET BARZ0=^BARBOB("BARZ",BARDUZ,DUZ(2),ARCOLIN,ARCOLITM,TDATE)
+24 SET BARFLG=$PIECE(BARZ0,U,5)
+25 ;PAIR FLAGGED OK OR IGNORABLE
IF BARFLG>0!(BARFLG="-I")
QUIT
+26 ;IPAC
SET TIPAC=$PIECE(BARZ0,U,2)
+27 ;CREDIT - DEBIT
SET TCRDEB=$PIECE(BARZ0,U,1)
+28 ;A/R BILL PTR
SET TARBILIN=$PIECE(BARZ0,U,3)
+29 ;A/R BILL NUMBER
SET TARBILL=$PIECE(BARZ0,U,4)
+30 ;NEGATIVE ENTRY IN COL BATCH
IF TCRDEB<0
Begin DoDot:2
ERR47 IF BARFLG=-7!(BARFLG=-4)!(BARFLG=-25)
Begin DoDot:3
+1 ;ONLY ERROR OUT SAME BILL
IF ARBILLIN=TARBILIN
SET ERR=-BARFLG
QUIT
End DoDot:3
QUIT
ERR36 ;NOT IN BILL, ERROR ALL OUT
IF BARFLG=-6!(BARFLG=-3)
SET ERR=-BARFLG
+1 ;FOUND THE PAIR
IF TIPAC=BARIPAC
IF (-ARCRDEB=TCRDEB)
SET BAROK=1
QUIT
ERR902 IF TIPAC'=BARIPAC&((-ARCRDEB)=(TCRDEB))
SET ERR=9.02
ERR901 IF TIPAC=BARIPAC&((-ARCRDEB)'=(TCRDEB))
SET ERR=9.01
ERR903 IF 'ERR
SET ERR=9.03
+1 SET BAR(0)=ERR
End DoDot:2
End DoDot:1
+2 ;FOUND A MATCH
IF BAROK
QUIT
+3 IF $DATA(BAR(0))
Begin DoDot:1
+4 SET BAROK=0
ERR9 ;COMPLEX PAYMENT/REVERSAL IN COLLECTION BATCH
DO ERR^BARUFEXU(BAR(0))
End DoDot:1
QUIT
+1 SET BAROK=1
+2 QUIT
+3 ;
ERR(MSG) ;NOT SENT ERROR MESSAGE CENTER
+1 ;
+2 DO ERR^BARUFEXU(MSG)
+3 QUIT
IPAC(X,Y,IENS) ;EP BAR*1.8*4 DD item 4.1.5.4
+1 SET Z=$$GET1^DIQ(90050.03,IENS,17,"E")
+2 ;FOUND IN TX FILE
IF Z'=""
QUIT Z
+3 ;S Z=$P($G(^BARCOL(DUZ(2),X,1,Y,0)),U,20) ;MRS:BAR*1.8*8 D150
+4 ;MRS:BAR*1.8*8 D150
SET Z=$$GET1^DIQ(90051.1101,Y_","_X_",",20)
+5 IF Z=""
SET Z="PRE-UFMS_COLLECTIONS"
+6 QUIT Z
