BAREDP4A.m

BAREDP4A ; IHS/SD/SDR - MATCH REASONS AND CLAIMS - 2 ; 01/09/2009

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**20,21,23,24**;OCT 26, 2005;Build 69

 ;CLM/CLM2 split BARFROM BAREDP04 due to size

 ;IHS/SD/POT	APR 2012 HEAT#62015 BUG FIX: DO NOT CALL ^%DT IF DOS="" - BAR*1.8*.23

 ;IHS/SD/POT NOV 2012 HEAT#82698  LEADING/MISSING ZEROES IN BILL #- BAR*1.8*.23

 ;IHS/SD/POT JAN 2014 MATCHING MANUAL BILLS (NO ALPHA)- BAR*1.8*.24

 ;;

PAYER    ;EP

 S IENS=BARCKIEN_","_IMPDA_","

 S EPAYER=$$GET1^DIQ(90056.02011,IENS,".06")

 D ^XBFMK

 S DIC=$$DIC^XBDIQ1(90056.24)

 S DIC(0)="SMQ"

 S X=EPAYER

 D ^DIC

 Q:+Y<0  ;stop here if no match in A/R EDI BILL LOGIC file

 W !!,"A matching ""override"" has been set up for this A/R Account",!

 S BARIEN=+Y

 D DISPLAY^BAREDMCH

 D ^XBFMK

 K DIR

 S DIR(0)="Y"

 S DIR("A")="Do you wish to continue with the A/R Bill Matching using this criteria?"

 S DIR("B")="N"

 D ^DIR

 I Y=0 S QFLG=1 Q

 Q

CLM(BAREIENS,BARBILL,BARX,BARMMFLG) ;EP

 NEW BARMMTOT,BARMCNT,BARMMTYP ;- BAR*1.8*.23

 S BARMMVAL="" ;RETURN VALUE OF MATCHED ITEM

 S BARCNT=0

 K BILMATCH S BILMATCH=0

 ;

 S BARMMFLG=0 ;NEGATIVE IF MATCH, 0 IF NO MATCH 1 FOR BILLED AMOUNT MATCH, 2 FOR DOS MATCH

 S BARMMTOT=0 ;COUNT OF MISMATCHES

 F I=0:1:3 S BARMMCNT(I)=0

 S BARFND=0

 ;

 I $$GET1^DIQ(90056.0205,BAREIENS,1.01)'="" D  Q  ;ALREADY MATCHED

 . S BARBIEN=$$GET1^DIQ(90056.0205,BAREIENS,1.01,"I")

 . S BARFND=10

 . S BARX="B"

 . I $D(^BARBL(DUZ(2),"G",BARBILL))!$D(^BARBL(DUZ(2),"G",+BARBILL)) S BARX="G"

 . S BARTMP=$$FINDING(BARBILL) I +BARTMP S BARX="G",(BARBILL)=$P(BARTMP,"^",2)

 . I $$CLM3(1,BARBIEN,IMPDA,CLMDA,.BARMMTYP) ;JUST DISPLAY (1ST PARAM=1)

 . Q

 ;-------------------------------------------------2/27/2013>- BAR*1.8*.23

 S BARX="G"

 I $D(^BARBL(DUZ(2),BARX,BARTEST)) D  Q

 . S BARFND=1051

 . D CLM2(BARX,BARTEST,.BARMMFLG)

 . Q

 ;

 S BARX="B"

 I $D(^BARBL(DUZ(2),BARX,BARTEST)) D  Q

 . S BARFND=1052

 . D CLM2(BARX,BARTEST,.BARMMFLG)

 . Q

 ;-------------------------------------------------2/27/2013<

 ;TRY TO MATCH MANUAL BILL (form: nnnnn-IHS-WHATEVER) 2/13/2014 - BAR*1.8*.24

 ;

 S BARX="G"

 ;

 S BARSAVE=+BARBILL

 S BARBILL=+BARBILL_"-" ;2/12/2014

 F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D

 . S BARFND=104

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 I BARFND QUIT  ;Found in POS

 S BARBILL=BARSAVE

 ;

 S BARX="B"

 ; 

 S BARSAVE=+BARBILL

 S BARBILL=+BARBILL_"-" ;2/12/2014

 F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D

 . S BARFND=105

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 I BARFND QUIT  ;found in A/R

 S BARBILL=BARSAVE

 ;---------------------------------------------------------------------------------- END 2/13/2014 

 S BARX="G"

 S BARSAVE=BARBILL,BARBILL=BARBILL_"@"

 F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D

 . S BARFND=104

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 I BARFND QUIT  ;If found in POS do not search in A/R -->

 S BARBILL=BARSAVE

 ;

 S BARX="B"

 S BARSAVE=BARBILL,BARBILL=BARBILL_"@"

 F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D

 . S BARFND=105

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 I BARFND QUIT  ;If found in POS do not search in A/R -->

 ;

 S BARBILL=BARSAVE

 ;

 ;CHK POS (OPTION WITH MISSING LEADING ZEROES) -------------------------

 ;

 S BARTMP=$$FINDING(BARBILL)

 I +BARTMP S BARX="G",(BARBILL)=$P(BARTMP,"^",2) D

 . S BARX="G",BARFND=100

 . D CLM2("G",BARBILL,.BARMMFLG)

 I BARFND QUIT  ;if found in POS do not search in A/R -->

 ;

 ;CHK POS (OPTION WITH LEADING ZEROES)

 ;

 I $D(^BARBL(DUZ(2),"G",BARBILL)) D

 . S BARX="G",BARFND=1

 . D CLM2("G",BARBILL,.BARMMFLG)

 I BARFND QUIT  ;if found in POS do not search in A/R -->

 ;

 ;CHK POS (OPTION WITH NO LEADING ZEROES)

 ;

 I +BARBILL'=BARBILL I $D(^BARBL(DUZ(2),"G",+BARBILL)) D

 . S BARX="G",BARFND=2

 . D CLM2("G",+BARBILL,.BARMMFLG) ;CHK POS

 I BARFND QUIT  ; if found in POS do not search in A/R -->

 ;

 S BARX="B" ;

 ;CHK POS (OPTION WITH LEADING ZEROES)

 ;

 I $D(^BARBL(DUZ(2),BARX,BARBILL)) D

 . S BARFND=3

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 I BARFND QUIT  ;

 S BARSAVE=BARBILL,BARBILL=BARBILL_"@"

 F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D

 . S BARFND=4

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 I BARFND QUIT  ;if found in POS do not search in A/R -->

 ;

 S BARSAVE=BARBILL

 F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'+BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D

 . S BARFND=4

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 S BARBILL=BARSAVE

 ;

 ;CHK POS (OPTION WITH NO LEADING ZEROES)

 ;

 I +BARBILL'=BARBILL I $D(^BARBL(DUZ(2),BARX,+BARBILL)) D

 . S BARFND=5

 . D CLM2(BARX,+BARBILL,.BARMMFLG)

 S BARSAVE=+BARBILL,BARBILL=+BARBILL_"@"

 ;

 F  S BARBILL=$O(^BARBL(DUZ(2),BARX,BARBILL)) Q:'BARBILL  Q:$E(BARBILL,1,$L(BARSAVE))'=BARSAVE  D

 . S BARFND=6

 . D CLM2(BARX,BARBILL,.BARMMFLG)

 I BARFND QUIT

 S BARBILL=BARSAVE

 Q

 ;

CLM2(BARX,BARBILL,BARMMFLG) ;

 S BARMMFLG=0

 S BARBIEN=0 F  S BARBIEN=$O(^BARBL(DUZ(2),BARX,BARBILL,BARBIEN)) Q:'+BARBIEN  D

 . I $$CLM3(2,BARBIEN,IMPDA,CLMDA,.BARMMTYP) D  Q  ;BLOCK FOR MATCHED

 . . S BARCNT=BARCNT+1

 . . S BARTMP(BARBIEN)="" ;ARRAY OF MATCHED BILLS

 . . S BARMMFLG=-1

 . . QUIT  ;

 . ;COUNTING TYPES OF UNMATCHED

 . S BARMMTOT=BARMMTOT+1 ;COUNT OF MISMATCHES (MM)

 . S BARMMCNT(BARMMTYP)=BARMMCNT(BARMMTYP)+1 ;COUNT TYPES OF MM

 . QUIT

 I $G(BARDBG) I BARMMCNT(1)+BARMMCNT(2)=1 D   ;ONE OR THE OTHER; NOT BOTH!

 . I BARMMCNT(1) S BARMMFLG=1 ;PARTIAL MATCH - AMOUNT MATCH"

 . I BARMMCNT(2) S BARMMFLG=2 ;PARTIAL MATCH - DOS MATCH"

 . Q

 Q

CLM3(BARFROM,BARBIEN,IMPDA,CLMDA,BARMMTYP) ;

 NEW ERABILL,ERADOS,BARDOS,BARAMT,ERATYPE,X,Y,ERADOS2

 S ERABILL=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,5)  ;E-BILLED

 S ERADOS=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,8)  ;E-DOS BEGIN

 S BARDOS=$$GET1^DIQ(90050.01,BARBIEN,102,"I")  ;DOS BEGIN

 S ERATYPE=$P($G(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)  ;E-CLM STATUS CD

 K %DT

 S X=ERADOS I X]"" D ^%DT I Y'=-1 S ERADOS=Y ;P.OTT

 S BARAMT=$$GET1^DIQ(90050.01,BARBIEN,13,"I")  ;AMT BILLED

 I $G(BARDBG) D

 . D INS^BAR50DET("ERA BILL : "_$$GET1^DIQ(90056.0205,BAREIENS,.01),0)

 . D INS^BAR50DET($C(9,9)_"ERA BILL TYPE: "_ERATYPE,1)

 . D INS^BAR50DET("BAR BILL : "_BARBILL,0)

 . D INS^BAR50DET("ERA BILLED: "_ERABILL_$C(9,9)_"ERA DOS: "_ERADOS,0)

 . I $$GET1^DIQ(90056.0205,BAREIENS,.01)=0 Q  ;BAR*1.8*24

 . D INS^BAR50DET("A/R BILLED: "_BARAMT_$C(9,9)_"A/R DOS: "_BARDOS,0)

 . D INS^BAR50DET("A/R BILL# : "_BARBILL,0)

 S BARMMTYP=0 ;MATCH

 I ERABILL<0 S ERABILL=-ERABILL D  Q 0

 . I $G(BARDBG) D INS^BAR50DET($c(9,9)_"ERA BILL IS A NEGATIVE AMOUNT",1)

 I (+ERABILL=+BARAMT),(ERADOS=BARDOS) D  Q 1

 . S BILMATCH=BILMATCH+1,BILMATCH(BARBIEN)=""

 . I $G(BARDBG) D INS^BAR50DET("  MATCHED!",1)

 . QUIT  ;OK

 ; ---- NOT MATCHED - OTHER REASON FALL THRU	

 I BARFROM=1 QUIT 0

 ;BARMMTYP=0 - MATCH

 ;BARMMTYP=1 ONLY AMOUNT NOT MATCHED

 ;BARMMTYP=2 ONLY DOS NOT MATCHED

 ;BARMMTYP=3 AMOUNT & DOS NOT MATCHED

 ;

 I (+ERABILL'=+BARAMT),(ERADOS'=BARDOS) S BARMMTYP=3 D  Q 0

 . I $G(BARDBG) D INS^BAR50DET(" NOT MATCHED",1) Q  ;

 I (+ERABILL'=+BARAMT),(ERADOS=BARDOS) S BARMMTYP=1 D  Q 0

 . I $G(BARDBG) D INS^BAR50DET(" PARTIAL MATCH: DOS OK. AMT DIFF: $ "_$J(ERABILL-BARAMT,5,2),1) S BARMMVAL=BARDOS

 I (ERADOS'=BARDOS),(+ERABILL=+BARAMT) S BARMMTYP=2 D  Q 0

 . I $G(BARDBG) D INS^BAR50DET(" PARTIAL MATCH: AMOUNT OK",1) S BARMMVAL=BARAMT

 ; ---- NOT MATCHED - OTHER REASON FALL THRU		

 Q 0

 ;

TRANSCK  ;EP

 Q:$G(BARBIEN)=""  ;no bill number matched

 S BARTFLG=0

 S BARBTCH=$$GET1^DIQ(90056.02011,BARCKIEN,.07)

 S BARITEM=$$GET1^DIQ(90056.02011,BARCKIEN,.08)

 S BARTR=0,BARTFLG=0

 F  S BARTR=$O(^BARTR(DUZ(2),"AC",BARBIEN,BARTR)) Q:'BARTR  D  Q:(BARTFLG=1)

 . S BARTBTCH=$$GET1^DIQ(90050.03,BARTR,14)

 . S BARTITEM=$$GET1^DIQ(90050.03,BARTR,15)

 . I BARTBTCH'="",BARITEM'="",BARBTCH=BARTBTCH,BARITEM=BARTITEM S BARTFLG=1

 I BARTFLG S ERRORS("HTRN")=""

 Q

FINDING(BARBILL) ;RETURNS 1^BARXBILL (WITH MISSED OR ADDED LEADING ZERORS); OR 0

 NEW BARXBILL,BARRET,IXX ;REWRITE JAN 2013

 I $E(BARBILL)'="0" D  Q BARRET

 . S BARRET=0

 . S BARXBILL=BARBILL

 . F IXX=1:1 Q:($L(BARXBILL)=20)  D  Q:BARRET

 . . S BARXBILL="0"_BARXBILL

 . . I $D(^BARBL(DUZ(2),"G",BARXBILL)) S BARRET="1^"_BARXBILL

 . . Q

 . Q

 I $E(BARBILL)="0" D  Q BARRET

 . S BARRET=0

 . S BARXBILL=BARBILL

 . F IXX=1:1 Q:$E(BARXBILL,1)'="0"  D  Q:BARRET

 . . S BARXBILL=$E(BARXBILL,2,999) I BARXBILL=""  Q

 . . I $D(^BARBL(DUZ(2),"G",BARXBILL)) S BARRET="1^"_BARXBILL

 . . Q

 . Q

    I BARBILL=+BARBILL D  Q BARRET

    . S BARXBILL=+BARBILL

    . I $D(^BARBL(DUZ(2),"G",BARXBILL)) S BARRET="1^"_BARXBILL

    . Q

 Q ""  ;NEVER FALLS THROUGH

BAREDP4A  ; IHS/SD/SDR - MATCH REASONS AND CLAIMS - 2 ; 01/09/2009

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**20,21,23,24**;OCT 26, 2005;Build 69

 +2       ;CLM/CLM2 split BARFROM BAREDP04 due to size

 +3       ;IHS/SD/POT	APR 2012 HEAT#62015 BUG FIX: DO NOT CALL ^%DT IF DOS="" - BAR*1.8*.23

 +4       ;IHS/SD/POT NOV 2012 HEAT#82698  LEADING/MISSING ZEROES IN BILL #- BAR*1.8*.23

 +5       ;IHS/SD/POT JAN 2014 MATCHING MANUAL BILLS (NO ALPHA)- BAR*1.8*.24

 +6       ;;

PAYER     ;EP

 +1        SET IENS=BARCKIEN_","_IMPDA_","

 +2        SET EPAYER=$$GET1^DIQ(90056.02011,IENS,".06")

 +3        DO ^XBFMK

 +4        SET DIC=$$DIC^XBDIQ1(90056.24)

 +5        SET DIC(0)="SMQ"

 +6        SET X=EPAYER

 +7        DO ^DIC

 +8       ;stop here if no match in A/R EDI BILL LOGIC file

           IF +Y<0

               QUIT 

 +9        WRITE !!,"A matching ""override"" has been set up for this A/R Account",!

 +10       SET BARIEN=+Y

 +11       DO DISPLAY^BAREDMCH

 +12       DO ^XBFMK

 +13       KILL DIR

 +14       SET DIR(0)="Y"

 +15       SET DIR("A")="Do you wish to continue with the A/R Bill Matching using this criteria?"

 +16       SET DIR("B")="N"

 +17       DO ^DIR

 +18       IF Y=0

               SET QFLG=1

               QUIT 

 +19       QUIT 

CLM(BAREIENS,BARBILL,BARX,BARMMFLG) ;EP

 +1       ;- BAR*1.8*.23

           NEW BARMMTOT,BARMCNT,BARMMTYP

 +2       ;RETURN VALUE OF MATCHED ITEM

           SET BARMMVAL=""

 +3        SET BARCNT=0

 +4        KILL BILMATCH

           SET BILMATCH=0

 +5       ;

 +6       ;NEGATIVE IF MATCH, 0 IF NO MATCH 1 FOR BILLED AMOUNT MATCH, 2 FOR DOS MATCH

           SET BARMMFLG=0

 +7       ;COUNT OF MISMATCHES

           SET BARMMTOT=0

 +8        FOR I=0:1:3

               SET BARMMCNT(I)=0

 +9        SET BARFND=0

 +10      ;

 +11      ;ALREADY MATCHED

           IF $$GET1^DIQ(90056.0205,BAREIENS,1.01)'=""

               Begin DoDot:1

 +12               SET BARBIEN=$$GET1^DIQ(90056.0205,BAREIENS,1.01,"I")

 +13               SET BARFND=10

 +14               SET BARX="B"

 +15               IF $DATA(^BARBL(DUZ(2),"G",BARBILL))!$DATA(^BARBL(DUZ(2),"G",+BARBILL))

                       SET BARX="G"

 +16               SET BARTMP=$$FINDING(BARBILL)

                   IF +BARTMP

                       SET BARX="G"

                       SET (BARBILL)=$PIECE(BARTMP,"^",2)

 +17      ;JUST DISPLAY (1ST PARAM=1)

                   IF $$CLM3(1,BARBIEN,IMPDA,CLMDA,.BARMMTYP)

 +18               QUIT 

               End DoDot:1

               QUIT 

 +19      ;-------------------------------------------------2/27/2013>- BAR*1.8*.23

 +20       SET BARX="G"

 +21       IF $DATA(^BARBL(DUZ(2),BARX,BARTEST))

               Begin DoDot:1

 +22               SET BARFND=1051

 +23               DO CLM2(BARX,BARTEST,.BARMMFLG)

 +24               QUIT 

               End DoDot:1

               QUIT 

 +25      ;

 +26       SET BARX="B"

 +27       IF $DATA(^BARBL(DUZ(2),BARX,BARTEST))

               Begin DoDot:1

 +28               SET BARFND=1052

 +29               DO CLM2(BARX,BARTEST,.BARMMFLG)

 +30               QUIT 

               End DoDot:1

               QUIT 

 +31      ;-------------------------------------------------2/27/2013<

 +32      ;TRY TO MATCH MANUAL BILL (form: nnnnn-IHS-WHATEVER) 2/13/2014 - BAR*1.8*.24

 +33      ;

 +34       SET BARX="G"

 +35      ;

 +36       SET BARSAVE=+BARBILL

 +37      ;2/12/2014

           SET BARBILL=+BARBILL_"-"

 +38       FOR 

               SET BARBILL=$ORDER(^BARBL(DUZ(2),BARX,BARBILL))

               IF '+BARBILL

                   QUIT 

               IF $EXTRACT(BARBILL,1,$LENGTH(BARSAVE))'=BARSAVE

                   QUIT 

               Begin DoDot:1

 +39               SET BARFND=104

 +40               DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +41      ;Found in POS

           IF BARFND

               QUIT 

 +42       SET BARBILL=BARSAVE

 +43      ;

 +44       SET BARX="B"

 +45      ; 

 +46       SET BARSAVE=+BARBILL

 +47      ;2/12/2014

           SET BARBILL=+BARBILL_"-"

 +48       FOR 

               SET BARBILL=$ORDER(^BARBL(DUZ(2),BARX,BARBILL))

               IF '+BARBILL

                   QUIT 

               IF $EXTRACT(BARBILL,1,$LENGTH(BARSAVE))'=BARSAVE

                   QUIT 

               Begin DoDot:1

 +49               SET BARFND=105

 +50               DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +51      ;found in A/R

           IF BARFND

               QUIT 

 +52       SET BARBILL=BARSAVE

 +53      ;---------------------------------------------------------------------------------- END 2/13/2014 

 +54       SET BARX="G"

 +55       SET BARSAVE=BARBILL

           SET BARBILL=BARBILL_"@"

 +56       FOR 

               SET BARBILL=$ORDER(^BARBL(DUZ(2),BARX,BARBILL))

               IF '+BARBILL

                   QUIT 

               IF $EXTRACT(BARBILL,1,$LENGTH(BARSAVE))'=BARSAVE

                   QUIT 

               Begin DoDot:1

 +57               SET BARFND=104

 +58               DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +59      ;If found in POS do not search in A/R -->

           IF BARFND

               QUIT 

 +60       SET BARBILL=BARSAVE

 +61      ;

 +62       SET BARX="B"

 +63       SET BARSAVE=BARBILL

           SET BARBILL=BARBILL_"@"

 +64       FOR 

               SET BARBILL=$ORDER(^BARBL(DUZ(2),BARX,BARBILL))

               IF '+BARBILL

                   QUIT 

               IF $EXTRACT(BARBILL,1,$LENGTH(BARSAVE))'=BARSAVE

                   QUIT 

               Begin DoDot:1

 +65               SET BARFND=105

 +66               DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +67      ;If found in POS do not search in A/R -->

           IF BARFND

               QUIT 

 +68      ;

 +69       SET BARBILL=BARSAVE

 +70      ;

 +71      ;CHK POS (OPTION WITH MISSING LEADING ZEROES) -------------------------

 +72      ;

 +73       SET BARTMP=$$FINDING(BARBILL)

 +74       IF +BARTMP

               SET BARX="G"

               SET (BARBILL)=$PIECE(BARTMP,"^",2)

               Begin DoDot:1

 +75               SET BARX="G"

                   SET BARFND=100

 +76               DO CLM2("G",BARBILL,.BARMMFLG)

               End DoDot:1

 +77      ;if found in POS do not search in A/R -->

           IF BARFND

               QUIT 

 +78      ;

 +79      ;CHK POS (OPTION WITH LEADING ZEROES)

 +80      ;

 +81       IF $DATA(^BARBL(DUZ(2),"G",BARBILL))

               Begin DoDot:1

 +82               SET BARX="G"

                   SET BARFND=1

 +83               DO CLM2("G",BARBILL,.BARMMFLG)

               End DoDot:1

 +84      ;if found in POS do not search in A/R -->

           IF BARFND

               QUIT 

 +85      ;

 +86      ;CHK POS (OPTION WITH NO LEADING ZEROES)

 +87      ;

 +88       IF +BARBILL'=BARBILL

               IF $DATA(^BARBL(DUZ(2),"G",+BARBILL))

                   Begin DoDot:1

 +89                   SET BARX="G"

                       SET BARFND=2

 +90      ;CHK POS

                       DO CLM2("G",+BARBILL,.BARMMFLG)

                   End DoDot:1

 +91      ; if found in POS do not search in A/R -->

           IF BARFND

               QUIT 

 +92      ;

 +93      ;

           SET BARX="B"

 +94      ;CHK POS (OPTION WITH LEADING ZEROES)

 +95      ;

 +96       IF $DATA(^BARBL(DUZ(2),BARX,BARBILL))

               Begin DoDot:1

 +97               SET BARFND=3

 +98               DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +99      ;

           IF BARFND

               QUIT 

 +100      SET BARSAVE=BARBILL

           SET BARBILL=BARBILL_"@"

 +101      FOR 

               SET BARBILL=$ORDER(^BARBL(DUZ(2),BARX,BARBILL))

               IF '+BARBILL

                   QUIT 

               IF $EXTRACT(BARBILL,1,$LENGTH(BARSAVE))'=BARSAVE

                   QUIT 

               Begin DoDot:1

 +102              SET BARFND=4

 +103              DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +104     ;if found in POS do not search in A/R -->

           IF BARFND

               QUIT 

 +105     ;

 +106      SET BARSAVE=BARBILL

 +107      FOR 

               SET BARBILL=$ORDER(^BARBL(DUZ(2),BARX,BARBILL))

               IF '+BARBILL

                   QUIT 

               IF $EXTRACT(BARBILL,1,$LENGTH(BARSAVE))'=BARSAVE

                   QUIT 

               Begin DoDot:1

 +108              SET BARFND=4

 +109              DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +110      SET BARBILL=BARSAVE

 +111     ;

 +112     ;CHK POS (OPTION WITH NO LEADING ZEROES)

 +113     ;

 +114      IF +BARBILL'=BARBILL

               IF $DATA(^BARBL(DUZ(2),BARX,+BARBILL))

                   Begin DoDot:1

 +115                  SET BARFND=5

 +116                  DO CLM2(BARX,+BARBILL,.BARMMFLG)

                   End DoDot:1

 +117      SET BARSAVE=+BARBILL

           SET BARBILL=+BARBILL_"@"

 +118     ;

 +119      FOR 

               SET BARBILL=$ORDER(^BARBL(DUZ(2),BARX,BARBILL))

               IF 'BARBILL

                   QUIT 

               IF $EXTRACT(BARBILL,1,$LENGTH(BARSAVE))'=BARSAVE

                   QUIT 

               Begin DoDot:1

 +120              SET BARFND=6

 +121              DO CLM2(BARX,BARBILL,.BARMMFLG)

               End DoDot:1

 +122      IF BARFND

               QUIT 

 +123      SET BARBILL=BARSAVE

 +124      QUIT 

 +125     ;

CLM2(BARX,BARBILL,BARMMFLG) ;

 +1        SET BARMMFLG=0

 +2        SET BARBIEN=0

           FOR 

               SET BARBIEN=$ORDER(^BARBL(DUZ(2),BARX,BARBILL,BARBIEN))

               IF '+BARBIEN

                   QUIT 

               Begin DoDot:1

 +3       ;BLOCK FOR MATCHED

                   IF $$CLM3(2,BARBIEN,IMPDA,CLMDA,.BARMMTYP)

                       Begin DoDot:2

 +4                        SET BARCNT=BARCNT+1

 +5       ;ARRAY OF MATCHED BILLS

                           SET BARTMP(BARBIEN)=""

 +6                        SET BARMMFLG=-1

 +7       ;

                           QUIT 

                       End DoDot:2

                       QUIT 

 +8       ;COUNTING TYPES OF UNMATCHED

 +9       ;COUNT OF MISMATCHES (MM)

                   SET BARMMTOT=BARMMTOT+1

 +10      ;COUNT TYPES OF MM

                   SET BARMMCNT(BARMMTYP)=BARMMCNT(BARMMTYP)+1

 +11               QUIT 

               End DoDot:1

 +12      ;ONE OR THE OTHER; NOT BOTH!

           IF $GET(BARDBG)

               IF BARMMCNT(1)+BARMMCNT(2)=1

                   Begin DoDot:1

 +13      ;PARTIAL MATCH - AMOUNT MATCH"

                       IF BARMMCNT(1)

                           SET BARMMFLG=1

 +14      ;PARTIAL MATCH - DOS MATCH"

                       IF BARMMCNT(2)

                           SET BARMMFLG=2

 +15                   QUIT 

                   End DoDot:1

 +16       QUIT 

CLM3(BARFROM,BARBIEN,IMPDA,CLMDA,BARMMTYP) ;

 +1        NEW ERABILL,ERADOS,BARDOS,BARAMT,ERATYPE,X,Y,ERADOS2

 +2       ;E-BILLED

           SET ERABILL=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,5)

 +3       ;E-DOS BEGIN

           SET ERADOS=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,8)

 +4       ;DOS BEGIN

           SET BARDOS=$$GET1^DIQ(90050.01,BARBIEN,102,"I")

 +5       ;E-CLM STATUS CD

           SET ERATYPE=$PIECE($GET(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,0)),U,11)

 +6        KILL %DT

 +7       ;P.OTT

           SET X=ERADOS

           IF X]""

               DO ^%DT

               IF Y'=-1

                   SET ERADOS=Y

 +8       ;AMT BILLED

           SET BARAMT=$$GET1^DIQ(90050.01,BARBIEN,13,"I")

 +9        IF $GET(BARDBG)

               Begin DoDot:1

 +10               DO INS^BAR50DET("ERA BILL : "_$$GET1^DIQ(90056.0205,BAREIENS,.01),0)

 +11               DO INS^BAR50DET($CHAR(9,9)_"ERA BILL TYPE: "_ERATYPE,1)

 +12               DO INS^BAR50DET("BAR BILL : "_BARBILL,0)

 +13               DO INS^BAR50DET("ERA BILLED: "_ERABILL_$CHAR(9,9)_"ERA DOS: "_ERADOS,0)

 +14      ;BAR*1.8*24

                   IF $$GET1^DIQ(90056.0205,BAREIENS,.01)=0

                       QUIT 

 +15               DO INS^BAR50DET("A/R BILLED: "_BARAMT_$CHAR(9,9)_"A/R DOS: "_BARDOS,0)

 +16               DO INS^BAR50DET("A/R BILL# : "_BARBILL,0)

               End DoDot:1

 +17      ;MATCH

           SET BARMMTYP=0

 +18       IF ERABILL<0

               SET ERABILL=-ERABILL

               Begin DoDot:1

 +19               IF $GET(BARDBG)