Routine: BAREUTL

BAREUTL ; IHS/SD/LSL - EDI UTILITIES ;  11/05/2008

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**23**;OCT 26, 2005

 ;MAR 2013 P.OTT DO NOT SHOW CHKS IF NOT PART OF THE ERA FILE

 ; ********************************************************************

CHKSEL(IMPDA,BARACTN) ; EP

 ; List checks for file and allow user to choose

 N BARRAY

 D GETCHK ;GET ARRAY OF CHECKS P.OTT

 D DISPLAY                             ; Display list

 I BARCNT<1 D  Q BARCKIEN

 . S BARCKIEN=0

 . I BARACTN="POST" W !!,"I'm sorry. You must first REVIEW checks before they can be posted."

 . I BARACTN="REVIEW" W !!,"I'm sorry, there are no checks to review."

 . I BARACTN="REPORT" W !!,"I'm sorry, there are no checks available for reporting"

 . D EOP^BARUTL(1)

 D ASK                                 ; Ask user to choose

 Q BARCKIEN                            ; IEN to A/R EDI Check file

 ; ********************************************************************

GETCHK N IENS,I,BARI ;P.OTT

 K BARRAY

 S I=0 F  S I=$O(^BAREDI("I",DUZ(2),IMPDA,5,I)) Q:'I  D

 . S IENS=I_","_IMPDA_","

 . S BARI=$$GET1^DIQ(90056.02011,IENS,.01) I BARI="" Q

 . S BARRAY(BARI)=""

 . ;W ! ZW BARRAY W ! ;P.OTT

DISPLAY ;

 ; Loop checks to choose from (A/R EDI CHECKS File)

 N BARANS,BARCHECK,BARCHK,BARBATCH,BARITEM

 K BARTMP,BARCNT

 I BARACTN="REVIEW" W $$EN^BARVDF("IOF")

 S BARCNT=0

 S BARCKIEN=0

 F  S BARCKIEN=$O(^BARECHK("C",IMPDA,BARCKIEN)) Q:'+BARCKIEN  D LINE

 ; ********************************************************************

LINE ;

 ; Display each check for ERA file

 K BARTMP2

 Q:'$D(^BARECHK(BARCKIEN))

 S BARDTREV=$P($G(^BARECHK(BARCKIEN,0)),U,5)

 ; If posting, only list reviewed checks

 I BARACTN="POST",BARDTREV="" Q

 S BARTMP2=$G(^BARECHK(BARCKIEN,0))

 S BARXCHK=$P(BARTMP2,U,1)

 I BARXCHK]"" I '$D(BARRAY(BARXCHK)) Q  ;P.OTT W !,"CHECK ",BARXCHK,"  --- IS NOT A PART OF THE ERA FILE!"

 S BARCNT=BARCNT+1

 S BARBTCH=$P(BARTMP2,U,3)

 ;I BARBTCH]"" D             ;IHS/OIT/MRS:BAR*1.8*10 H831

 D                           ;IHS/OIT/MRS:BAR*1.8*10 H831

 . S BARBTCHN=$$GET1^DIQ(90051.01,BARBTCH,.01)

 . S BARIENS=$P(BARTMP2,U,4)_","_BARBTCH_","

 . S BARACCT=$$GET1^DIQ(90051.1101,BARIENS,7)

 . S BARBDOL=$$GET1^DIQ(90051.1101,BARIENS,101)

 . S BARBBAL=$$GET1^DIQ(90051.1101,BARIENS,19)

 S:$G(BARBTCHN)="" BARBTCHN="** no RPMS match **"

 S BARTMP(BARCNT)=BARCKIEN

 W !!,$J(BARCNT,2),")"

 W " CHECK #: ",$E($P(BARTMP2,U),1,16)

 W ?31,"BATCH:",?38,$E($G(BARBTCHN),1,31)

 W ?71,"ITEM: ",$J($P(BARTMP2,U,4),3)

 W !?7,"A/R ACCOUNT: ",$E($G(BARACCT),1,15)

 W ?36,"BATCHED AMT: ",$J($FN($G(BARBDOL),",",2),10)

 W ?61,"BALANCE: ",$J($FN($G(BARBBAL),",",2),10)

 ; ********************************************************************

ASK ;

 ; Ask user to select check to post

W !

 S BARCKIEN=0

 K DIR

 S DIR(0)="NAO^1:"_BARCNT

 S DIR("A")="Please enter the LINE # of the check you wish to "_BARACTN_": "

 I BARCNT=1 S DIR("B")=BARCNT

 S DIR("?")="Enter a number between 1 and "_BARCNT

 D ^DIR

 I Y>0 S BARCKIEN=BARTMP(+Y)

BAREUTL   ; IHS/SD/LSL - EDI UTILITIES ;  11/05/2008

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**23**;OCT 26, 2005

 +2       ;MAR 2013 P.OTT DO NOT SHOW CHKS IF NOT PART OF THE ERA FILE

 +3        QUIT

 +4       ; ********************************************************************

 +5       ;

 +6       ;

CHKSEL(IMPDA,BARACTN) ; EP

 +1       ; List checks for file and allow user to choose

 +2        NEW BARRAY

 +3       ;GET ARRAY OF CHECKS P.OTT

           DO GETCHK

 +4       ; Display list

           DO DISPLAY

 +5        IF BARCNT<1

               Begin DoDot:1

 +6                SET BARCKIEN=0

 +7                IF BARACTN="POST"

                       WRITE !!,"I'm sorry. You must first REVIEW checks before they can be posted."

 +8                IF BARACTN="REVIEW"

                       WRITE !!,"I'm sorry, there are no checks to review."

 +9                IF BARACTN="REPORT"

                       WRITE !!,"I'm sorry, there are no checks available for reporting"

 +10               DO EOP^BARUTL(1)

               End DoDot:1

               QUIT BARCKIEN

 +11      ; Ask user to choose

           DO ASK

 +12      ; IEN to A/R EDI Check file

           QUIT BARCKIEN

 +13      ; ********************************************************************

GETCHK    ;P.OTT

           NEW IENS,I,BARI

 +1        KILL BARRAY

 +2        SET I=0

FOR

               SET I=$ORDER(^BAREDI("I",DUZ(2),IMPDA,5,I))

               IF 'I

                   QUIT

               Begin DoDot:1

 +3                SET IENS=I_","_IMPDA_","

 +4                SET BARI=$$GET1^DIQ(90056.02011,IENS,.01)

                   IF BARI=""

                       QUIT

 +5                SET BARRAY(BARI)=""

 +6       ;W ! ZW BARRAY W ! ;P.OTT

               End DoDot:1

 +7        QUIT

 +8       ;

DISPLAY   ;

 +1       ; Loop checks to choose from (A/R EDI CHECKS File)

 +2        NEW BARANS,BARCHECK,BARCHK,BARBATCH,BARITEM

 +3        KILL BARTMP,BARCNT

 +4        IF BARACTN="REVIEW"

               WRITE $$EN^BARVDF("IOF")

 +5        SET BARCNT=0

 +6        SET BARCKIEN=0

 +7        FOR

               SET BARCKIEN=$ORDER(^BARECHK("C",IMPDA,BARCKIEN))

               IF '+BARCKIEN

                   QUIT

               DO LINE

 +8        QUIT

 +9       ; ********************************************************************

 +10      ;

LINE      ;

 +1       ; Display each check for ERA file

 +2        KILL BARTMP2

 +3        IF '$DATA(^BARECHK(BARCKIEN))

               QUIT

 +4        SET BARDTREV=$PIECE($GET(^BARECHK(BARCKIEN,0)),U,5)

 +5       ; If posting, only list reviewed checks

 +6        IF BARACTN="POST"

               IF BARDTREV=""

                   QUIT

 +7        SET BARTMP2=$GET(^BARECHK(BARCKIEN,0))

 +8        SET BARXCHK=$PIECE(BARTMP2,U,1)

 +9       ;P.OTT W !,"CHECK ",BARXCHK,"  --- IS NOT A PART OF THE ERA FILE!"

           IF BARXCHK]""

               IF '$DATA(BARRAY(BARXCHK))

                   QUIT

 +10       SET BARCNT=BARCNT+1

 +11       SET BARBTCH=$PIECE(BARTMP2,U,3)

 +12      ;I BARBTCH]"" D             ;IHS/OIT/MRS:BAR*1.8*10 H831

 +13      ;IHS/OIT/MRS:BAR*1.8*10 H831

           Begin DoDot:1

 +14           SET BARBTCHN=$$GET1^DIQ(90051.01,BARBTCH,.01)

 +15           SET BARIENS=$PIECE(BARTMP2,U,4)_","_BARBTCH_","

 +16           SET BARACCT=$$GET1^DIQ(90051.1101,BARIENS,7)

 +17           SET BARBDOL=$$GET1^DIQ(90051.1101,BARIENS,101)

 +18           SET BARBBAL=$$GET1^DIQ(90051.1101,BARIENS,19)

           End DoDot:1

 +19       IF $GET(BARBTCHN)=""

               SET BARBTCHN="** no RPMS match **"

 +20       SET BARTMP(BARCNT)=BARCKIEN

 +21       WRITE !!,$JUSTIFY(BARCNT,2),")"

 +22       WRITE " CHECK #: ",$EXTRACT($PIECE(BARTMP2,U),1,16)

 +23       WRITE ?31,"BATCH:",?38,$EXTRACT($GET(BARBTCHN),1,31)

 +24       WRITE ?71,"ITEM: ",$JUSTIFY($PIECE(BARTMP2,U,4),3)

 +25       WRITE !?7,"A/R ACCOUNT: ",$EXTRACT($GET(BARACCT),1,15)

 +26       WRITE ?36,"BATCHED AMT: ",$JUSTIFY($FNUMBER($GET(BARBDOL),",",2),10)

 +27       WRITE ?61,"BALANCE: ",$JUSTIFY($FNUMBER($GET(BARBBAL),",",2),10)

 +28       QUIT

 +29      ; ********************************************************************

 +30      ;

ASK       ;

 +1       ; Ask user to select check to post

 +2        WRITE !

 +3        SET BARCKIEN=0

 +4        KILL DIR

 +5        SET DIR(0)="NAO^1:"_BARCNT

 +6        SET DIR("A")="Please enter the LINE # of the check you wish to "_BARACTN_": "

 +7        IF BARCNT=1

               SET DIR("B")=BARCNT

 +8        SET DIR("?")="Enter a number between 1 and "_BARCNT

 +9        DO ^DIR

 +10       IF Y>0

               SET BARCKIEN=BARTMP(+Y)

 +11       QUIT

BAREUTL.m