BAREDP09 ; IHS/SD/LSL - FIND ERA CHECKS AND MATCH TO RPMS ;07/08/2008
;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20,21,22,23,24**;OCT 26,2005;Build 69
;IHS/SD/POT HEAT#82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS)- BAR*1.8*.23
;IHS/SD/POT MAR 2013 EXCLUDED COL BATCHES OLDER THAN 365 DAYS- BAR*1.8*.23
;IHS/SD/POT HEAT152930 02/12/2014 CONVERTED BATCHEIN AND BATCHDATE TO EXTERNALS - BAR*1.8*.24
Q
CHECK(IMPDA) ; EP
N BARCNT,BARCNT2,BARTMP,BARCHK
D ERACHECK ;find all chks on ERA
I '+BARCNT D Q 0 ;TPF 11/21/2005 BAR*1.8*1 IM19058,IM17965,IM19546
. W !,"I'm sorry, it seems ERA file ",IMPDA," does not contain "
. W !,"a Check/EFT Trace Number. The file cannot be posted."
. K DIC,DIE,DR,DA
. S DA=IMPDA
. S DIE="^BAREDI(""I"",DUZ(2),"
. S DR=".08////T" ;UP-Missing Chk#
. D ^DIE
. D EOP^BARUTL(1)
D BATCHECK ;Find ERA chks in Coll Batch
D MATCH ;Match ERA to RPMS Batch/Item
D CONT ;Matching complete, cont?
Q:'+Y 0 ;NOT REPORTED BAR*1.8*1
;start new bar*1.8*20 REQ3
D STORE
W $$EN^BARVDF("IOF")
D DISPLAY
W !!?1,"IMPORT FILE SUMMARY:"
W !?7,"TOTAL SEGMENTS PROCESSED........:",$J($P($G(^BAREDI("I",DUZ(2),IMPDA,15,0)),U,3),12)
W !?7,"TOTAL AMOUNT PROCESSED..........$",$J($FN((+$G(BARMAMT)+$G(BARNAMT)),",",2),12)
I +$G(BARNAMT)'=0 W !!?1,"PLEASE REVIEW THE BPR 'NOT FOUND' REPORT AND CREATE A BATCH FOR THE BPR SEGMENT 'NOT FOUND'."
I +$G(BARPLB)>0 W !!?1,"* - Indicates a PLB segment has been located.",!?5,"Collection item balance may not match check balance!"
D EOP^BARUTL(1)
;end new REQ3
Q BARCKIEN
ERACHECK ;
;First find all chks for file (ERA) selected ( I=IEN for chk entry)
N BARCHECK,BARITEM,BARBATCH
S BARCNT=0
S I=0
F S I=$O(^BAREDI("I",DUZ(2),IMPDA,5,I)) Q:'I D
. ;end new REQ3
. S BARCNT=BARCNT+1 ;# chks on ERA
. S IENS=I_","_IMPDA_","
. S ($P(BARCHK(I),U),BARI)=$$GET1^DIQ(90056.02011,IENS,.01)
. S $P(BARCHK(I),U,2)=0
. D EXIST
Q
EXIST ;
;See if ERA chk already in A/R EDI Chk file & matched to AR
I '$D(^BARECHK("B",BARI)) Q
S BARMTCH=0
S BARCKIEN=0
F S BARCKIEN=$O(^BARECHK("B",BARI,BARCKIEN)) Q:'+BARCKIEN D Q:+BARMTCH
. Q:$P($G(^BARECHK(BARCKIEN,0)),U,2)'=IMPDA
. S BARMTCH=1
. S $P(BARCHK(I),U,5)=BARCKIEN
I 'BARMTCH Q
S BARBATCH=$P($G(^BARECHK(BARCKIEN,0)),U,3)
S BARITEM=$P($G(^BARECHK(BARCKIEN,0)),U,4)
I +BARBATCH,+BARITEM D
. S $P(BARCHK(I),U,3)=BARBATCH
. S $P(BARCHK(I),U,4)=BARITEM
. ;end new REQ3
Q
BATCHECK ;
;Now loop to find occurrence of ERA chks in A/R Coll. Batch
N BARBATCH,BATITEM,BARCHECK,BARXCHK,BARTODAY,%H
S X=DT D H^%DTC ;GET $H-FORMAT ;- BAR*1.8*.23
S BARTODAY=%H
S BARCHECK="" F S BARCHECK=$O(BARCHK(BARCHECK)) Q:BARCHECK="" D
. S BARCHKN=$P(BARCHK(BARCHECK),U)
. S BARXCHK=$$BARXCHK^BAREDP09(BARCHKN) ;- BAR*1.8*.24
. I $P(BARCHK(BARCHECK),U,3),$P(BARCHK(BARCHECK),U,4) D Q
. . S BARBATCH=$P(BARCHK(BARCHECK),U,3)
. . S BARITEM=$P(BARCHK(BARCHECK),U,4)
. . S BARCNT2=1
. . S $P(BARCHK(BARCHECK),U,2)=BARCNT2
. . D BTCHDATA
. . I $G(BARTMP)<BARCNT2 S BARTMP=BARCNT2
. S BARCNT2=0
. I '$D(^BARCOL(DUZ(2),"D",BARXCHK)) S $P(BARCHK(BARCHECK),U,2)=0,BARTMP=0 Q ;- BAR*1.8*.23
. I $D(^BARCOL(DUZ(2),"D",BARXCHK)) D
. . S BARBATCH=0 F S BARBATCH=$O(^BARCOL(DUZ(2),"D",BARXCHK,BARBATCH)) Q:'+BARBATCH D ;Collection Batch IEN - BAR*1.8*.23
. . . NEW X,BARCBDT ;- BAR*1.8*.23
. . . S X=$$GET1^DIQ(90051.01,BARBATCH_",",4,"I")
. . . D H^%DTC ;GET $H-FORMAT
. . . S BARCBDT=%H
. . . IF BARTODAY-BARCBDT>365 D Q ;- BAR*1.8*.23
. . . . S $P(BARCHK(BARCHECK),U,2)=0,BARTMP=0
. . . . W !!,"A/R Collection batch found is older than 365 days. Checks will NOT be"
. . . . W !,"matched in the ERA file AND will not be posted to the Collection Batch"
. . . . ;old code W !," CHK:",BARXCHK," BATCH: ",BARBATCH," BATCH DATE: ",BARCBDT
. . . . W !," CHK:",BARXCHK," BATCH: ",$$GET1^DIQ(90051.01,BARBATCH,.01)," BATCH DATE: ",$P($$GET1^DIQ(90051.01,BARBATCH_",",4,"I"),"@",1) ;HEAT152930 - BAR*1.8*.24
. . . . D EOP^BARUTL(1)
. . . S BARITEM=0 ;Item#
. . . F S BARITEM=$O(^BARCOL(DUZ(2),"D",BARXCHK,BARBATCH,BARITEM)) Q:'+BARITEM D
. . . . S BARCNT2=BARCNT2+1
. . . . D BTCHDATA
. S $P(BARCHK(BARCHECK),U,2)=BARCNT2
. I $G(BARTMP)<BARCNT2 S BARTMP=BARCNT2
Q
BTCHDATA ;
;Gather data for coll. batch
K BARIENS
S BARIENS=BARITEM_","_BARBATCH_","
S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U)=$$GET1^DIQ(90051.01,BARBATCH,.01) ;NAME
S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,2)=$$GET1^DIQ(90051.1101,BARIENS,7) ;A/R ACCT
S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,3)=$$GET1^DIQ(90051.1101,BARIENS,101) ;CREDIT
S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,4)=$$GET1^DIQ(90051.1101,BARIENS,19) ;ITEM POSTING BALANCE
S $P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,5)=$$GET1^DIQ(90051.1101,BARIENS,17)
I (U_"ROLLED UP"_U_"CANCELED"_U)[(U_$P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,5)_U) K BARCHK(BARCHECK,BARBATCH,BARITEM) S BARCNT=BARCNT-1
Q
MATCH ;
; Loop chks & tell user matched status
N BARCHECK,BAREITM,BAREBTCH,BARBATCH,BARITEM
S BARCHECK=""
F S BARCHECK=$O(BARCHK(BARCHECK)) Q:BARCHECK="" D
. S IENS=BARCHECK_","_IMPDA_","
. W !!,"#"_BARCHECK_" BPR02: ",$FN($$GET1^DIQ(90056.02011,IENS,.03),",",2)
. W !?4,"TRN02: ",$$GET1^DIQ(90056.02011,IENS,.01)
. W ?40,"Matching... "
. ; chk if prev. matched
. S BAREBTCH=$P($G(BARCHK(BARCHECK)),U,3)
. S BAREITM=$P($G(BARCHK(BARCHECK)),U,4) ;bar*2.8*20 REQ3
. I $P($G(^BAREDI("I",DUZ(2),IMPDA,5,BARCHECK,0)),U,7)'="" D PREVIOUS Q
. I $P(BARCHK(BARCHECK),U,2)=0 D NONE Q
. I $P(BARCHK(BARCHECK),U,2)=1 D ONLYONE Q
. D MANY
Q
PREVIOUS ;
; This ERA chk previously matched to coll. batch
W " Previously matched"
W !,"Matched to batch ",$P(BARCHK(BARCHECK,BAREBTCH,BAREITM),U),?50," ITEM: ",BAREITM
I $$GET1^DIQ(90051.01,BAREBTCH_",",28)'="" W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.01,BAREBTCH_",",28)
E W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.1101,BAREITM_","_BAREBTCH_",",20)
S BARMCNT=+$G(BARMCNT)+1
S BARMAMT=+$G(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
Q
NONE ;
; No coll. batch/item for this chk#
W "not done!"
W !,"Match to: COLLECTION BATCH/ITEM NOT FOUND. PLACING ON NOT FOUND REPORT!"
S BARNCNT=+$G(BARNCNT)+1
S BARNAMT=+$G(BARNAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
S (BARBATCH,BARITEM)=""
D UPDCHECK
Q
ONLYONE ;
; This ERA chk only matches 1 coll. batch/item
S BARBATCH=$O(BARCHK(BARCHECK,""))
S BARITEM=$O(BARCHK(BARCHECK,BARBATCH,""))
S BARCHKN=$P(BARCHK(BARCHECK),U)
W "done!"
W !,"Match to: ",$P(BARCHK(BARCHECK,BARBATCH,BARITEM),U),?50," ITEM: ",BARITEM
S $P(BARCHK(BARCHECK),U,3)=BARBATCH,$P(BARCHK(BARCHECK),U,4)=BARITEM
I $$GET1^DIQ(90051.01,BARBATCH_",",28)'="" W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.01,BARBATCH_",",28)
E W !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.1101,BARITEM_","_BARBATCH_",",20) ;TPF 3/24/2008 BAR*1.8*5 FY08-SRS-90
D UPDCHECK
S BARMCNT=+$G(BARMCNT)+1
S BARMAMT=+$G(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
Q
MANY ;
;This ERA chk matches >1 coll. batch/item. Ask user to choose
W !!,"Chk/EFT # ",BARCHECK," matches more than one collection batch and item."
W !,"Please select one:"
D LISTCHK
D ASK
I '+BARANS D Q
. W !!,"A collection batch/item has NOT been selected for this ERA Chk/EFT #"
S BARBATCH=$P(BARTMP(BARANS),U)
S BARITEM=$P(BARTMP(BARANS),U,2)
S $P(BARCHK(BARCHECK),U,3)=BARBATCH,$P(BARCHK(BARCHECK),U,4)=BARITEM
S BARCHKN=$P(BARCHK(BARCHECK),U) ;IHS/SD/TPF BAR*1.8*21 HEAT43451
W !!,"Updating A/R EDI CHECKS file with Collection Batch Data..." ;bar*1.8*22
D UPDCHECK
W " ... Done!"
S BARMCNT=+$G(BARMCNT)+1
S BARMAMT=+$G(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
;end new REQ3
Q
LISTCHK ;
; List possible batches for ERA chk so user can choose
W !!,$$EN^BARVDF("ULN"),"LINE",?11,"BATCH",?35,"ITEM",?42,"A/R ACCOUNT",?57,"$ BATCHED",?70,"BALANCE",$$EN^BARVDF("ULF")
K BARTMP
S (BARBATCH,BARCNT)=0
F S BARBATCH=$O(BARCHK(BARCHECK,BARBATCH)) Q:'+BARBATCH D
. S BARITEM=0
. F S BARITEM=$O(BARCHK(BARCHECK,BARBATCH,BARITEM)) Q:'+BARITEM D
. . S BARCNT=BARCNT+1
. . W !,$J(BARCNT,3)
. . W ?5,$E($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U),1,31)
. . W ?36,$J(BARITEM,3)
. . W ?40,$E($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,2),1,15)
. . W ?56,$J($FN($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,3),",",2),10)
. . W ?67,$J($FN($P(BARCHK(BARCHECK,BARBATCH,BARITEM),U,4),",",2),10)
. . S BARTMP(BARCNT)=BARBATCH_U_BARITEM
Q
ASK ;
;Ask user to choose batch/item
W !
S BARANS=0
K DIR
S DIR(0)="NAO^1:"_BARCNT
S DIR("A")="Please enter the LINE # of the collection batch/item that matches this ERA: "
S DIR("?")="Enter a number between 1 and "_BARCNT
S DIR("??")="^D LISTCHK^BAREDPA1"
D ^DIR
S BARANS=Y
Q
UPDCHECK ; EP
;Populate A/R EDI Checks File
;I '$D(^BARECHK("B",BARCHECK)) D Q
I '$D(^BARECHK("B",BARCHKN)) D Q
. D ADD
. Q:'+BARCKIEN
. D UPD
S BARMTCH=0
S BARCKIEN=0
F S BARCKIEN=$O(^BARECHK("B",BARCHKN,BARCKIEN)) Q:'+BARCKIEN D Q:+BARMTCH
. Q:$P($G(^BARECHK(BARCKIEN,0)),U,2)'=IMPDA
. S BARMTCH=1
I 'BARMTCH D ADD
Q:'+BARCKIEN
D UPD
Q
ADD ;
;Add new entry to A/R EDI Check
K DIC,DA,DR
S DIC="^BARECHK("
S DIC(0)="XZ"
S X=BARCHKN
K DO,DD D FILE^DICN
I +Y<1 D Q
. S BARCKIEN=0
S BARCKIEN=+Y
Q
UPD ;
;Update entry in A/R EDI Check
K DIE,DIC,DA,DR,X,Y
S DIE="^BARECHK("
S DA=BARCKIEN
S DR=".02////^S X=IMPDA" ;RLT - IM13516
I BARBATCH'="" S DR=DR_";.03////^S X=BARBATCH"
I BARITEM'="" S DR=DR_";.04///^S X=BARITEM"
D ^DIE
Q
CONT ;
W !!
I +$G(BARMCNT)>0 D
. W !?2,BARMCNT_" "_$S(+$G(BARMCNT)=1:"ENTRY HAS ",1:"ENTRIES HAVE ")_"BEEN MATCHED.....................$",?50,$J($FN(BARMAMT,",",2),12)
I +$G(BARNCNT)>0 D
. W !?2,BARNCNT_" "_$S(+$G(BARNCNT)=1:"ENTRY HAS ",1:"ENTRIES HAVE ")_"NOT BEEN MATCHED.................$",?50,$J($FN(BARNAMT,",",2),12)
W !,?40,"TOTAL.....$",$J($FN((+$G(BARMAMT)+$G(BARNAMT)),",",2),12)
D EOP^BARUTL(1)
Q
STORE ;
S BARI=0
F S BARI=$O(BARCHK(BARI)) Q:'BARI D
. Q:$P(BARCHK(BARI),U,3)="" ;no batch
. D ^XBFMK
. S DA(1)=IMPDA
. S DA=BARI
. S DIE="^BAREDI(""I"","_DUZ(2)_","_DA(1)_",5,"
. S DR=".07////"_$P(BARCHK(BARI),U,3)_";.08////"_$P(BARCHK(BARI),U,4)_";.11///MPN"
. D ^DIE
Q
DISPLAY ;
S BAR("PG")=0
S $P(BARDASH,"-",81)=""
D SETHDR
D HDB
S BARI=0
F S BARI=$O(^BAREDI("I",DUZ(2),IMPDA,5,BARI)) Q:'BARI D
. S BARREC=$G(^BAREDI("I",DUZ(2),IMPDA,5,BARI,0))
. S BARST=$P(BARREC,U,2)
. W !?1,$E(BARST,($L(BARST)-3),$L(BARST))
. I $P(BARREC,U,9) W "*" S BARPLB=1 ;PLB on chk
. W ?10,$J($FN($P(BARREC,U,3),",",2),12),?24,$P(BARREC,U)
. I $P(BARREC,U,7)="" W ?47,"NOT FOUND"
. I $P(BARREC,U,7)'="" D
. . S IENS=BARI_","_IMPDA_","
. . W ?47,$$GET1^DIQ(90056.02011,IENS,.07)_" "_$P(BARREC,U,8)
Q
SETHDR ;
;Set up Rpt Hdr
K BARPCIEN,BARPC,BARIIEN,BARAIEN
K IMP
D ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")
S BAR("HD",0)="ERA/RPMS CHECK MATCHING REPORT"
S BAR("HD",1)="LOCATION: "_$$GET1^DIQ(4,DUZ(2),.01)
S BAR("HD",2)="FOR RPMS FILE: "_IMP(.01)
Q
HDB ;EP
S BAR("COL")="W !,""ST"",?12,""AMOUNT"",?32,""CHECK#"",?50,""COLL. BATCH/ITEM FOUND"""
S BAR("PG")=BAR("PG")+1
I BAR("PG")>1 S BAR("LVL")=4
D WHD^BARRHD
X BAR("COL")
W !,BARDASH,!
Q
BARXCHK(X) ;
I $D(^BARCOL(DUZ(2),"D",X)) Q X ;CHECK # AS SEND IN ERA FILE
I $D(^BARCOL(DUZ(2),"D",+X)) Q +X ;;CHECK # W/O LEADING ZEROES
Q X ;NOT FOUND - DON'T CHANGE
;-----EOR-----
BAREDP09 ; IHS/SD/LSL - FIND ERA CHECKS AND MATCH TO RPMS ;07/08/2008
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,4,5,6,20,21,22,23,24**;OCT 26,2005;Build 69
+2 ;IHS/SD/POT HEAT#82698 NOV 2012 LEADING ZEROES IN CHKECK # (POS)- BAR*1.8*.23
+3 ;IHS/SD/POT MAR 2013 EXCLUDED COL BATCHES OLDER THAN 365 DAYS- BAR*1.8*.23
+4 ;IHS/SD/POT HEAT152930 02/12/2014 CONVERTED BATCHEIN AND BATCHDATE TO EXTERNALS - BAR*1.8*.24
+5 QUIT
CHECK(IMPDA) ; EP
+1 NEW BARCNT,BARCNT2,BARTMP,BARCHK
+2 ;find all chks on ERA
DO ERACHECK
+3 ;TPF 11/21/2005 BAR*1.8*1 IM19058,IM17965,IM19546
IF '+BARCNT
Begin DoDot:1
+4 WRITE !,"I'm sorry, it seems ERA file ",IMPDA," does not contain "
+5 WRITE !,"a Check/EFT Trace Number. The file cannot be posted."
+6 KILL DIC,DIE,DR,DA
+7 SET DA=IMPDA
+8 SET DIE="^BAREDI(""I"",DUZ(2),"
+9 ;UP-Missing Chk#
SET DR=".08////T"
+10 DO ^DIE
+11 DO EOP^BARUTL(1)
End DoDot:1
QUIT 0
+12 ;Find ERA chks in Coll Batch
DO BATCHECK
+13 ;Match ERA to RPMS Batch/Item
DO MATCH
+14 ;Matching complete, cont?
DO CONT
+15 ;NOT REPORTED BAR*1.8*1
IF '+Y
QUIT 0
+16 ;start new bar*1.8*20 REQ3
+17 DO STORE
+18 WRITE $$EN^BARVDF("IOF")
+19 DO DISPLAY
+20 WRITE !!?1,"IMPORT FILE SUMMARY:"
+21 WRITE !?7,"TOTAL SEGMENTS PROCESSED........:",$JUSTIFY($PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,15,0)),U,3),12)
+22 WRITE !?7,"TOTAL AMOUNT PROCESSED..........$",$JUSTIFY($FNUMBER((+$GET(BARMAMT)+$GET(BARNAMT)),",",2),12)
+23 IF +$GET(BARNAMT)'=0
WRITE !!?1,"PLEASE REVIEW THE BPR 'NOT FOUND' REPORT AND CREATE A BATCH FOR THE BPR SEGMENT 'NOT FOUND'."
+24 IF +$GET(BARPLB)>0
WRITE !!?1,"* - Indicates a PLB segment has been located.",!?5,"Collection item balance may not match check balance!"
+25 DO EOP^BARUTL(1)
+26 ;end new REQ3
+27 QUIT BARCKIEN
ERACHECK ;
+1 ;First find all chks for file (ERA) selected ( I=IEN for chk entry)
+2 NEW BARCHECK,BARITEM,BARBATCH
+3 SET BARCNT=0
+4 SET I=0
+5 FOR
SET I=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,I))
IF 'I
QUIT
Begin DoDot:1
+6 ;end new REQ3
+7 ;# chks on ERA
SET BARCNT=BARCNT+1
+8 SET IENS=I_","_IMPDA_","
+9 SET ($PIECE(BARCHK(I),U),BARI)=$$GET1^DIQ(90056.02011,IENS,.01)
+10 SET $PIECE(BARCHK(I),U,2)=0
+11 DO EXIST
End DoDot:1
+12 QUIT
EXIST ;
+1 ;See if ERA chk already in A/R EDI Chk file & matched to AR
+2 IF '$DATA(^BARECHK("B",BARI))
QUIT
+3 SET BARMTCH=0
+4 SET BARCKIEN=0
+5 FOR
SET BARCKIEN=$ORDER(^BARECHK("B",BARI,BARCKIEN))
IF '+BARCKIEN
QUIT
Begin DoDot:1
+6 IF $PIECE($GET(^BARECHK(BARCKIEN,0)),U,2)'=IMPDA
QUIT
+7 SET BARMTCH=1
+8 SET $PIECE(BARCHK(I),U,5)=BARCKIEN
End DoDot:1
IF +BARMTCH
QUIT
+9 IF 'BARMTCH
QUIT
+10 SET BARBATCH=$PIECE($GET(^BARECHK(BARCKIEN,0)),U,3)
+11 SET BARITEM=$PIECE($GET(^BARECHK(BARCKIEN,0)),U,4)
+12 IF +BARBATCH
IF +BARITEM
Begin DoDot:1
+13 SET $PIECE(BARCHK(I),U,3)=BARBATCH
+14 SET $PIECE(BARCHK(I),U,4)=BARITEM
+15 ;end new REQ3
End DoDot:1
+16 QUIT
BATCHECK ;
+1 ;Now loop to find occurrence of ERA chks in A/R Coll. Batch
+2 NEW BARBATCH,BATITEM,BARCHECK,BARXCHK,BARTODAY,%H
+3 ;GET $H-FORMAT ;- BAR*1.8*.23
SET X=DT
DO H^%DTC
+4 SET BARTODAY=%H
+5 SET BARCHECK=""
FOR
SET BARCHECK=$ORDER(BARCHK(BARCHECK))
IF BARCHECK=""
QUIT
Begin DoDot:1
+6 SET BARCHKN=$PIECE(BARCHK(BARCHECK),U)
+7 ;- BAR*1.8*.24
SET BARXCHK=$$BARXCHK^BAREDP09(BARCHKN)
+8 IF $PIECE(BARCHK(BARCHECK),U,3)
IF $PIECE(BARCHK(BARCHECK),U,4)
Begin DoDot:2
+9 SET BARBATCH=$PIECE(BARCHK(BARCHECK),U,3)
+10 SET BARITEM=$PIECE(BARCHK(BARCHECK),U,4)
+11 SET BARCNT2=1
+12 SET $PIECE(BARCHK(BARCHECK),U,2)=BARCNT2
+13 DO BTCHDATA
+14 IF $GET(BARTMP)<BARCNT2
SET BARTMP=BARCNT2
End DoDot:2
QUIT
+15 SET BARCNT2=0
+16 ;- BAR*1.8*.23
IF '$DATA(^BARCOL(DUZ(2),"D",BARXCHK))
SET $PIECE(BARCHK(BARCHECK),U,2)=0
SET BARTMP=0
QUIT
+17 IF $DATA(^BARCOL(DUZ(2),"D",BARXCHK))
Begin DoDot:2
+18 ;Collection Batch IEN - BAR*1.8*.23
SET BARBATCH=0
FOR
SET BARBATCH=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,BARBATCH))
IF '+BARBATCH
QUIT
Begin DoDot:3
+19 ;- BAR*1.8*.23
NEW X,BARCBDT
+20 SET X=$$GET1^DIQ(90051.01,BARBATCH_",",4,"I")
+21 ;GET $H-FORMAT
DO H^%DTC
+22 SET BARCBDT=%H
+23 ;- BAR*1.8*.23
IF BARTODAY-BARCBDT>365
Begin DoDot:4
+24 SET $PIECE(BARCHK(BARCHECK),U,2)=0
SET BARTMP=0
+25 WRITE !!,"A/R Collection batch found is older than 365 days. Checks will NOT be"
+26 WRITE !,"matched in the ERA file AND will not be posted to the Collection Batch"
+27 ;old code W !," CHK:",BARXCHK," BATCH: ",BARBATCH," BATCH DATE: ",BARCBDT
+28 ;HEAT152930 - BAR*1.8*.24
WRITE !," CHK:",BARXCHK," BATCH: ",$$GET1^DIQ(90051.01,BARBATCH,.01)," BATCH DATE: ",$PIECE($$GET1^DIQ(90051.01,BARBATCH_",",4,"I"),"@",1)
+29 DO EOP^BARUTL(1)
End DoDot:4
QUIT
+30 ;Item#
SET BARITEM=0
+31 FOR
SET BARITEM=$ORDER(^BARCOL(DUZ(2),"D",BARXCHK,BARBATCH,BARITEM))
IF '+BARITEM
QUIT
Begin DoDot:4
+32 SET BARCNT2=BARCNT2+1
+33 DO BTCHDATA
End DoDot:4
End DoDot:3
End DoDot:2
+34 SET $PIECE(BARCHK(BARCHECK),U,2)=BARCNT2
+35 IF $GET(BARTMP)<BARCNT2
SET BARTMP=BARCNT2
End DoDot:1
+36 QUIT
BTCHDATA ;
+1 ;Gather data for coll. batch
+2 KILL BARIENS
+3 SET BARIENS=BARITEM_","_BARBATCH_","
+4 ;NAME
SET $PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U)=$$GET1^DIQ(90051.01,BARBATCH,.01)
+5 ;A/R ACCT
SET $PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,2)=$$GET1^DIQ(90051.1101,BARIENS,7)
+6 ;CREDIT
SET $PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,3)=$$GET1^DIQ(90051.1101,BARIENS,101)
+7 ;ITEM POSTING BALANCE
SET $PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,4)=$$GET1^DIQ(90051.1101,BARIENS,19)
+8 SET $PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,5)=$$GET1^DIQ(90051.1101,BARIENS,17)
+9 IF (U_"ROLLED UP"_U_"CANCELED"_U)[(U_$PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,5)_U)
KILL BARCHK(BARCHECK,BARBATCH,BARITEM)
SET BARCNT=BARCNT-1
+10 QUIT
MATCH ;
+1 ; Loop chks & tell user matched status
+2 NEW BARCHECK,BAREITM,BAREBTCH,BARBATCH,BARITEM
+3 SET BARCHECK=""
+4 FOR
SET BARCHECK=$ORDER(BARCHK(BARCHECK))
IF BARCHECK=""
QUIT
Begin DoDot:1
+5 SET IENS=BARCHECK_","_IMPDA_","
+6 WRITE !!,"#"_BARCHECK_" BPR02: ",$FNUMBER($$GET1^DIQ(90056.02011,IENS,.03),",",2)
+7 WRITE !?4,"TRN02: ",$$GET1^DIQ(90056.02011,IENS,.01)
+8 WRITE ?40,"Matching... "
+9 ; chk if prev. matched
+10 SET BAREBTCH=$PIECE($GET(BARCHK(BARCHECK)),U,3)
+11 ;bar*2.8*20 REQ3
SET BAREITM=$PIECE($GET(BARCHK(BARCHECK)),U,4)
+12 IF $PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,5,BARCHECK,0)),U,7)'=""
DO PREVIOUS
QUIT
+13 IF $PIECE(BARCHK(BARCHECK),U,2)=0
DO NONE
QUIT
+14 IF $PIECE(BARCHK(BARCHECK),U,2)=1
DO ONLYONE
QUIT
+15 DO MANY
End DoDot:1
+16 QUIT
PREVIOUS ;
+1 ; This ERA chk previously matched to coll. batch
+2 WRITE " Previously matched"
+3 WRITE !,"Matched to batch ",$PIECE(BARCHK(BARCHECK,BAREBTCH,BAREITM),U),?50," ITEM: ",BAREITM
+4 IF $$GET1^DIQ(90051.01,BAREBTCH_",",28)'=""
WRITE !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.01,BAREBTCH_",",28)
+5 IF '$TEST
WRITE !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.1101,BAREITM_","_BAREBTCH_",",20)
+6 SET BARMCNT=+$GET(BARMCNT)+1
+7 SET BARMAMT=+$GET(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
+8 QUIT
NONE ;
+1 ; No coll. batch/item for this chk#
+2 WRITE "not done!"
+3 WRITE !,"Match to: COLLECTION BATCH/ITEM NOT FOUND. PLACING ON NOT FOUND REPORT!"
+4 SET BARNCNT=+$GET(BARNCNT)+1
+5 SET BARNAMT=+$GET(BARNAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
+6 SET (BARBATCH,BARITEM)=""
+7 DO UPDCHECK
+8 QUIT
ONLYONE ;
+1 ; This ERA chk only matches 1 coll. batch/item
+2 SET BARBATCH=$ORDER(BARCHK(BARCHECK,""))
+3 SET BARITEM=$ORDER(BARCHK(BARCHECK,BARBATCH,""))
+4 SET BARCHKN=$PIECE(BARCHK(BARCHECK),U)
+5 WRITE "done!"
+6 WRITE !,"Match to: ",$PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U),?50," ITEM: ",BARITEM
+7 SET $PIECE(BARCHK(BARCHECK),U,3)=BARBATCH
SET $PIECE(BARCHK(BARCHECK),U,4)=BARITEM
+8 IF $$GET1^DIQ(90051.01,BARBATCH_",",28)'=""
WRITE !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.01,BARBATCH_",",28)
+9 ;TPF 3/24/2008 BAR*1.8*5 FY08-SRS-90
IF '$TEST
WRITE !?5,"TDN/IPAC: ",$$GET1^DIQ(90051.1101,BARITEM_","_BARBATCH_",",20)
+10 DO UPDCHECK
+11 SET BARMCNT=+$GET(BARMCNT)+1
+12 SET BARMAMT=+$GET(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
+13 QUIT
MANY ;
+1 ;This ERA chk matches >1 coll. batch/item. Ask user to choose
+2 WRITE !!,"Chk/EFT # ",BARCHECK," matches more than one collection batch and item."
+3 WRITE !,"Please select one:"
+4 DO LISTCHK
+5 DO ASK
+6 IF '+BARANS
Begin DoDot:1
+7 WRITE !!,"A collection batch/item has NOT been selected for this ERA Chk/EFT #"
End DoDot:1
QUIT
+8 SET BARBATCH=$PIECE(BARTMP(BARANS),U)
+9 SET BARITEM=$PIECE(BARTMP(BARANS),U,2)
+10 SET $PIECE(BARCHK(BARCHECK),U,3)=BARBATCH
SET $PIECE(BARCHK(BARCHECK),U,4)=BARITEM
+11 ;IHS/SD/TPF BAR*1.8*21 HEAT43451
SET BARCHKN=$PIECE(BARCHK(BARCHECK),U)
+12 ;bar*1.8*22
WRITE !!,"Updating A/R EDI CHECKS file with Collection Batch Data..."
+13 DO UPDCHECK
+14 WRITE " ... Done!"
+15 SET BARMCNT=+$GET(BARMCNT)+1
+16 SET BARMAMT=+$GET(BARMAMT)+($$GET1^DIQ(90056.02011,IENS,.03))
+17 ;end new REQ3
+18 QUIT
LISTCHK ;
+1 ; List possible batches for ERA chk so user can choose
+2 WRITE !!,$$EN^BARVDF("ULN"),"LINE",?11,"BATCH",?35,"ITEM",?42,"A/R ACCOUNT",?57,"$ BATCHED",?70,"BALANCE",$$EN^BARVDF("ULF")
+3 KILL BARTMP
+4 SET (BARBATCH,BARCNT)=0
+5 FOR
SET BARBATCH=$ORDER(BARCHK(BARCHECK,BARBATCH))
IF '+BARBATCH
QUIT
Begin DoDot:1
+6 SET BARITEM=0
+7 FOR
SET BARITEM=$ORDER(BARCHK(BARCHECK,BARBATCH,BARITEM))
IF '+BARITEM
QUIT
Begin DoDot:2
+8 SET BARCNT=BARCNT+1
+9 WRITE !,$JUSTIFY(BARCNT,3)
+10 WRITE ?5,$EXTRACT($PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U),1,31)
+11 WRITE ?36,$JUSTIFY(BARITEM,3)
+12 WRITE ?40,$EXTRACT($PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,2),1,15)
+13 WRITE ?56,$JUSTIFY($FNUMBER($PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,3),",",2),10)
+14 WRITE ?67,$JUSTIFY($FNUMBER($PIECE(BARCHK(BARCHECK,BARBATCH,BARITEM),U,4),",",2),10)
+15 SET BARTMP(BARCNT)=BARBATCH_U_BARITEM
End DoDot:2
End DoDot:1
+16 QUIT
ASK ;
+1 ;Ask user to choose batch/item
+2 WRITE !
+3 SET BARANS=0
+4 KILL DIR
+5 SET DIR(0)="NAO^1:"_BARCNT
+6 SET DIR("A")="Please enter the LINE # of the collection batch/item that matches this ERA: "
+7 SET DIR("?")="Enter a number between 1 and "_BARCNT
+8 SET DIR("??")="^D LISTCHK^BAREDPA1"
+9 DO ^DIR
+10 SET BARANS=Y
+11 QUIT
UPDCHECK ; EP
+1 ;Populate A/R EDI Checks File
+2 ;I '$D(^BARECHK("B",BARCHECK)) D Q
+3 IF '$DATA(^BARECHK("B",BARCHKN))
Begin DoDot:1
+4 DO ADD
+5 IF '+BARCKIEN
QUIT
+6 DO UPD
End DoDot:1
QUIT
+7 SET BARMTCH=0
+8 SET BARCKIEN=0
+9 FOR
SET BARCKIEN=$ORDER(^BARECHK("B",BARCHKN,BARCKIEN))
IF '+BARCKIEN
QUIT
Begin DoDot:1
+10 IF $PIECE($GET(^BARECHK(BARCKIEN,0)),U,2)'=IMPDA
QUIT
+11 SET BARMTCH=1
End DoDot:1
IF +BARMTCH
QUIT
+12 IF 'BARMTCH
DO ADD
+13 IF '+BARCKIEN
QUIT
+14 DO UPD
+15 QUIT
ADD ;
+1 ;Add new entry to A/R EDI Check
+2 KILL DIC,DA,DR
+3 SET DIC="^BARECHK("
+4 SET DIC(0)="XZ"
+5 SET X=BARCHKN
+6 KILL DO,DD
DO FILE^DICN
+7 IF +Y<1
Begin DoDot:1
+8 SET BARCKIEN=0
End DoDot:1
QUIT
+9 SET BARCKIEN=+Y
+10 QUIT
UPD ;
+1 ;Update entry in A/R EDI Check
+2 KILL DIE,DIC,DA,DR,X,Y
+3 SET DIE="^BARECHK("
+4 SET DA=BARCKIEN
+5 ;RLT - IM13516
SET DR=".02////^S X=IMPDA"
+6 IF BARBATCH'=""
SET DR=DR_";.03////^S X=BARBATCH"
+7 IF BARITEM'=""
SET DR=DR_";.04///^S X=BARITEM"
+8 DO ^DIE
+9 QUIT
CONT ;
+1 WRITE !!
+2 IF +$GET(BARMCNT)>0
Begin DoDot:1
+3 WRITE !?2,BARMCNT_" "_$SELECT(+$GET(BARMCNT)=1:"ENTRY HAS ",1:"ENTRIES HAVE ")_"BEEN MATCHED.....................$",?50,$JUSTIFY($FNUMBER(BARMAMT,",",2),12)
End DoDot:1
+4 IF +$GET(BARNCNT)>0
Begin DoDot:1
+5 WRITE !?2,BARNCNT_" "_$SELECT(+$GET(BARNCNT)=1:"ENTRY HAS ",1:"ENTRIES HAVE ")_"NOT BEEN MATCHED.................$",?50,$JUSTIFY($FNUMBER(BARNAMT,",",2),12)
End DoDot:1
+6 WRITE !,?40,"TOTAL.....$",$JUSTIFY($FNUMBER((+$GET(BARMAMT)+$GET(BARNAMT)),",",2),12)
+7 DO EOP^BARUTL(1)
+8 QUIT
STORE ;
+1 SET BARI=0
+2 FOR
SET BARI=$ORDER(BARCHK(BARI))
IF 'BARI
QUIT
Begin DoDot:1
+3 ;no batch
IF $PIECE(BARCHK(BARI),U,3)=""
QUIT
+4 DO ^XBFMK
+5 SET DA(1)=IMPDA
+6 SET DA=BARI
+7 SET DIE="^BAREDI(""I"","_DUZ(2)_","_DA(1)_",5,"
+8 SET DR=".07////"_$PIECE(BARCHK(BARI),U,3)_";.08////"_$PIECE(BARCHK(BARI),U,4)_";.11///MPN"
+9 DO ^DIE
End DoDot:1
+10 QUIT
DISPLAY ;
+1 SET BAR("PG")=0
+2 SET $PIECE(BARDASH,"-",81)=""
+3 DO SETHDR
+4 DO HDB
+5 SET BARI=0
+6 FOR
SET BARI=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,BARI))
IF 'BARI
QUIT
Begin DoDot:1
+7 SET BARREC=$GET(^BAREDI("I",DUZ(2),IMPDA,5,BARI,0))
+8 SET BARST=$PIECE(BARREC,U,2)
+9 WRITE !?1,$EXTRACT(BARST,($LENGTH(BARST)-3),$LENGTH(BARST))
+10 ;PLB on chk
IF $PIECE(BARREC,U,9)
WRITE "*"
SET BARPLB=1
+11 WRITE ?10,$JUSTIFY($FNUMBER($PIECE(BARREC,U,3),",",2),12),?24,$PIECE(BARREC,U)
+12 IF $PIECE(BARREC,U,7)=""
WRITE ?47,"NOT FOUND"
+13 IF $PIECE(BARREC,U,7)'=""
Begin DoDot:2
+14 SET IENS=BARI_","_IMPDA_","
+15 WRITE ?47,$$GET1^DIQ(90056.02011,IENS,.07)_" "_$PIECE(BARREC,U,8)
End DoDot:2
End DoDot:1
+16 QUIT
SETHDR ;
+1 ;Set up Rpt Hdr
+2 KILL BARPCIEN,BARPC,BARIIEN,BARAIEN
+3 KILL IMP
+4 DO ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")
+5 SET BAR("HD",0)="ERA/RPMS CHECK MATCHING REPORT"
+6 SET BAR("HD",1)="LOCATION: "_$$GET1^DIQ(4,DUZ(2),.01)
+7 SET BAR("HD",2)="FOR RPMS FILE: "_IMP(.01)
+8 QUIT
HDB ;EP
+1 SET BAR("COL")="W !,""ST"",?12,""AMOUNT"",?32,""CHECK#"",?50,""COLL. BATCH/ITEM FOUND"""
+2 SET BAR("PG")=BAR("PG")+1
+3 IF BAR("PG")>1
SET BAR("LVL")=4
+4 DO WHD^BARRHD
+5 XECUTE BAR("COL")
+6 WRITE !,BARDASH,!
+7 QUIT
BARXCHK(X) ;
+1 ;CHECK # AS SEND IN ERA FILE
IF $DATA(^BARCOL(DUZ(2),"D",X))
QUIT X
+2 ;;CHECK # W/O LEADING ZEROES
IF $DATA(^BARCOL(DUZ(2),"D",+X))
QUIT +X
+3 ;NOT FOUND - DON'T CHANGE
QUIT X
+4 ;-----EOR-----
