Routine: BAR50P07

BAR50P07 ; IHS/SD/LSL - IMPORT CLAIM REPORTS ;

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

;;

EN ; EP

 K IMP

 D ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")

 W !,@IOF,!,"Reports for : ",?20,IMP(.01)

 W !,?20,IMP(.05)

 W !!,"Enter the list of Claim Status(s) you desire to print,"

 W !,"and in the sequence to be printed out.",!

 W !,"C - Claim Unmatched",?25,"R - Reason Unmatched",?50,"N - Not to Post"

 W !,"M - Matched",?25,"P - Posted",?50,"X - Claim & Reason Unmatched"

 W !,"A - All Categories",!,?5,"Example:   CRXN",!

 K DIR

 S DIR(0)="FO^0:6"

 D ^DIR

 K DIR

 I $L(Y)'>0 W !!,"NONE SELECTED - EXITING",! H 2 Q

 I Y="^" Q

 S Z="CRNMPX"

 I Y="A" S Y=Z

 S Z="CRNMPX"

 F I=1:1:$L(Y) I Z'[$E(Y,I) W !!,">>>BAD ENTRY<<<>>> ",Y H 2 G EN

 S BARINDX=Y

 S BARZ("C")="Claim Unmatched"

 S BARZ("P")="Posted"

 S BARZ("M")="Matched"

 S BARZ("N")="Not to Post"

 S BARZ("X")="Claim & Reason Unmatched"

 S BARZ("R")="Reason Unmatched"

W !

 K DIR

 S DIR(0)="SOB^D:Detailed;B:Brief - One Line;S:Summary - Totals Only"

 S DIR("A")="Select the type of report: "

 D ^DIR

 K DIR

 Q:Y="^"

 S BARTYP=Y

 ; -------------------------------

PRT ; EP

 ; GET DEVICE (QUEUEING ALLOWED)

 S Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)

 K DA

 Q:$D(DIRUT)

 I Y="B" D  Q

 . S XBFLD("BROWSE")=1

 . S BARIOSL=IOSL

 . S IOSL=600

 . D VIEWR^XBLM("LOOP^BAR50P07")

 . D FULL^VALM1

 . W $$EN^BARVDF("IOF")

 . D CLEAR^VALM1  ;clears out all list man stuff

 . K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF

 . K VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP

 . K VALMY,XQORS,XQORSPEW,VALMCOFF

. ;

DEVE . ;

 . S IOSL=BARIOSL

 . K BARIOSL

 S XBRP="LOOP^BAREDP07"

 S XBNS="BAR;IMP*"

 S XBRX="EXIT^BAREDP07"

 D ^XBDBQUE

 K DIR

 S DIR(0)="E"

 S DIR("A")="<CR> - Continue"

 D ^DIR

 K DIR

 G EN

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

ENDJOB ;

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

LOOP ;EP CLAIMS

 S BARPG("HDR")=IMP(.01)_"   "_IMP(.05)_"   CLAIM REPORT"

 D BARHDR

 S TOT=0,CNT=0

 K INDTOT,INDCNT,ADJTOT

 F XI=1:1:$L(BARINDX) S IND=$E(BARINDX,XI) D INDEX Q:BARQUIT

 G:BARQUIT EXIT

 D FINISH

 G EXIT

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

FINISH ; EP

 W !!,?3,"Grand Totals",?50,$J(CNT,6,0),?65,"$ ",$J(TOT,9,2)," <P>"

 I BARTYP'="S" Q

 W !!,?10,"ADJUSTMENT totals: "

 S ADJ="",TOT=0

 F  S ADJ=$O(ADJTOT(ADJ)) Q:ADJ=""  D

 . W !,?15,ADJ,?65,"$ ",$J(ADJTOT(ADJ),9,2)

 . S TOT=TOT+ADJTOT(ADJ)

 W !,?67,"=========="

 W !,?65,"$ ",$J(TOT,9,2),!

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

EXIT ; EP

 K CNT,TOT,IND,ADJ,INDTOT,INDCNT

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

HEADER ; EP

 Q:"S"=BARTYP

 W !,"E-Claim",?20,"Pat",?50,"DOSB",?65,"<P>ay"

 W:BARTYP="D" !,?20,"HRN | HIC",?50,"DOSE",?65,"<B>ILL",!,?65,"<O>utstanding"

W !

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

INDEX ; EP

 I BARTYP'="S" W !!,?3,BARZ(IND)

 S INDTOT(IND)=0,INDCNT(IND)=0,BARQUIT=0

 S CLMDA=0

 F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"AC",IND,CLMDA)) Q:CLMDA'>0  D CLAIM  Q:$G(BARQUIT)

 Q:$G(BARQUIT)

 W !,?3,BARZ(IND),?35,"TOTALS",?50,$J(INDCNT(IND),6,0),?65,"$ ",$J(INDTOT(IND),9,2)," <P>"

 S TOT=TOT+INDTOT(IND)

 S CNT=CNT+INDCNT(IND)

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

CLAIM ;EP

 ; WORK THE CLAIM

 K CLM,ADJ

 D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")

 S INDTOT(IND)=INDTOT(IND)+CLM(.04),INDCNT(IND)=INDCNT(IND)+1

 D PRINT

 W:"BS"'[BARTYP !

 I BARTYP="S" D TOTADJ

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

TOTADJ ;EP

 ; for summary gather adj type totals

 K ADJ

 D ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".02;.04","ADJ(")

 N X,Y

 S I=0

 F  S I=$O(ADJ(I)) Q:I'>0  D

 . S X=ADJ(I,.02)

 . S Y=ADJ(I,.04)

 . S:Y="" Y="?"

 . S ADJTOT(Y)=$G(ADJTOT(Y))+X

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

PRINT ; EP

 ; print Claim info

 I BARTYP="S" Q

 D BARPG

 Q:$G(BARQUIT)

 W !,CLM(.01),?20,$E(CLM(.06),1,25),?50,$E(CLM(.08),1,12),?65,"$ ",$J(CLM(.04),9,2)," <P>"

 I BARTYP="B" Q

 W !,?20,CLM(.07),?50,CLM(.09),?63,?65,"$ ",$J(CLM(.05),9,2)," <B>"

 K ADJ

 D BARPG Q:$G(BARQUIT)

 D ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".01:.05","ADJ(")

 F ADJ=1:1 Q:'$D(ADJ(ADJ))  D

 . W !,?9,"$",$J(ADJ(ADJ,.02),8,2),?20,ADJ(ADJ,.03)

 . I "RX"[BARTYP Q

 . W !,?20,ADJ(ADJ,.04),?50,ADJ(ADJ,.05)

 I "MPN"[IND D ARINFO

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

ARINFO ; EP

 ; PRINT A/R INFO

 S DFN=$$VALI^XBDIQ1(90056.0205,"IMPDA,CLMDA",1.01)

 Q:'DFN

 D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA","1.01:1.07","CLM(")

 W !,?15,"AR",?20,$E(CLM(1.03),1,25),?50,$E(CLM(1.05),1,12),?65,"$ ",$J(CLM(1.07),9,2)," <O>"

 W !,?20,CLM(1.04),?50,$E(CLM(1.06),1,12),?65,"$ ",$J(CLM(1.02),9,2)," <B>"

END ;

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

BARPG ;EP

 ; PAGE CONTROLLER

 ; this utility uses variables BARPG("HDR"),BARPG("DT"),BARPG("LINE"),BARPG("PG")

 ; kill variables by D EBARPG

 Q:($Y<(IOSL-5))!($G(DOUT)!$G(DFOUT))

 S:'$D(BARPG("PG")) BARPG("PG")=0

 S BARPG("PG")=BARPG("PG")+1

 I $E(IOST)="C",IOT["TRM" D EOP^BARUTL(0)

 I ($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT)) S BARQUIT=1

Q ;

 Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))

BARHDR ; EP

 ; write page header

 W:$Y @IOF

W !

 Q:'$D(BARPG("HDR"))

 S:'$D(BARPG("LINE")) $P(BARPG("LINE"),"-",IOM-2)=""

 S:'$D(BARPG("PG")) BARPG("PG")=1

 I '$D(BARPG("DT")) D

 . S %H=$H

 . D YX^%DTC

 . S BARPG("DT")=Y

 U IO

 W ?(IOM-40-$L(BARPG("HDR"))/2),BARPG("HDR")

 W ?(IOM-40),BARPG("DT")

 W ?(IOM-10),"PAGE: ",BARPG("PG")

 W !,BARPG("LINE")

BARHD ; EP

 ; Write column header / message

 Q:"S"=BARTYP

 W !,"E-Claim",?20,"Pat",?50,"DOSB",?65,"$    <P>ay"

 W:BARTYP="D" !,?20,"HRN | HIC",?50,"DOSE",?65,"$    <B>ill",!,?65,"$    <O>ut"

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

 I ($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT)) S BARQUIT=1

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

EBARPG ;

 K BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")

BAR50P07  ; IHS/SD/LSL - IMPORT CLAIM REPORTS ;

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

 +2       ;;

EN        ; EP

 +1        KILL IMP

 +2        DO ENP^XBDIQ1(90056.02,IMPDA,".01;.05","IMP(")

 +3        WRITE !,@IOF,!,"Reports for : ",?20,IMP(.01)

 +4        WRITE !,?20,IMP(.05)

 +5        WRITE !!,"Enter the list of Claim Status(s) you desire to print,"

 +6        WRITE !,"and in the sequence to be printed out.",!

 +7        WRITE !,"C - Claim Unmatched",?25,"R - Reason Unmatched",?50,"N - Not to Post"

 +8        WRITE !,"M - Matched",?25,"P - Posted",?50,"X - Claim & Reason Unmatched"

 +9        WRITE !,"A - All Categories",!,?5,"Example:   CRXN",!

 +10       KILL DIR

 +11       SET DIR(0)="FO^0:6"

 +12       DO ^DIR

 +13       KILL DIR

 +14       IF $LENGTH(Y)'>0

               WRITE !!,"NONE SELECTED - EXITING",!

               HANG 2

               QUIT

 +15       IF Y="^"

               QUIT

 +16       SET Z="CRNMPX"

 +17       IF Y="A"

               SET Y=Z

 +18       SET Z="CRNMPX"

 +19       FOR I=1:1:$LENGTH(Y)

               IF Z'[$EXTRACT(Y,I)

                   WRITE !!,">>>BAD ENTRY<<<>>> ",Y

                   HANG 2

                   GOTO EN

 +20       SET BARINDX=Y

 +21       SET BARZ("C")="Claim Unmatched"

 +22       SET BARZ("P")="Posted"

 +23       SET BARZ("M")="Matched"

 +24       SET BARZ("N")="Not to Post"

 +25       SET BARZ("X")="Claim & Reason Unmatched"

 +26       SET BARZ("R")="Reason Unmatched"

 +27       WRITE !

 +28       KILL DIR

 +29       SET DIR(0)="SOB^D:Detailed;B:Brief - One Line;S:Summary - Totals Only"

 +30       SET DIR("A")="Select the type of report: "

 +31       DO ^DIR

 +32       KILL DIR

 +33       IF Y="^"

               QUIT

 +34       SET BARTYP=Y

 +35      ; -------------------------------

 +36      ;

PRT       ; EP

 +1       ;

 +2       ; GET DEVICE (QUEUEING ALLOWED)

 +3        SET Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)

 +4        KILL DA

 +5        IF $DATA(DIRUT)

               QUIT

 +6        IF Y="B"

               Begin DoDot:1

 +7                SET XBFLD("BROWSE")=1

 +8                SET BARIOSL=IOSL

 +9                SET IOSL=600

 +10               DO VIEWR^XBLM("LOOP^BAR50P07")

 +11               DO FULL^VALM1

 +12               WRITE $$EN^BARVDF("IOF")

 +13      ;clears out all list man stuff

                   DO CLEAR^VALM1

 +14               KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF

 +15               KILL VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP

 +16               KILL VALMY,XQORS,XQORSPEW,VALMCOFF

 +17      ;

DEVE      ;

 +1                SET IOSL=BARIOSL

 +2                KILL BARIOSL

               End DoDot:1

               QUIT

 +3        SET XBRP="LOOP^BAREDP07"

 +4        SET XBNS="BAR;IMP*"

 +5        SET XBRX="EXIT^BAREDP07"

 +6        DO ^XBDBQUE

 +7        KILL DIR

 +8        SET DIR(0)="E"

 +9        SET DIR("A")="<CR> - Continue"

 +10       DO ^DIR

 +11       KILL DIR

 +12       GOTO EN

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

 +14      ;

ENDJOB    ;

 +1        QUIT

 +2       ; *********************************************************************

 +3       ;

LOOP      ;EP CLAIMS

 +1        SET BARPG("HDR")=IMP(.01)_"   "_IMP(.05)_"   CLAIM REPORT"

 +2        DO BARHDR

 +3        SET TOT=0

           SET CNT=0

 +4        KILL INDTOT,INDCNT,ADJTOT

 +5        FOR XI=1:1:$LENGTH(BARINDX)

               SET IND=$EXTRACT(BARINDX,XI)

               DO INDEX

               IF BARQUIT

                   QUIT

 +6        IF BARQUIT

               GOTO EXIT

 +7        DO FINISH

 +8        GOTO EXIT

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

 +10      ;

FINISH    ; EP

 +1        WRITE !!,?3,"Grand Totals",?50,$JUSTIFY(CNT,6,0),?65,"$ ",$JUSTIFY(TOT,9,2)," <P>"

 +2        IF BARTYP'="S"

               QUIT

 +3        WRITE !!,?10,"ADJUSTMENT totals: "

 +4        SET ADJ=""

           SET TOT=0

 +5        FOR

               SET ADJ=$ORDER(ADJTOT(ADJ))

               IF ADJ=""

                   QUIT

               Begin DoDot:1

 +6                WRITE !,?15,ADJ,?65,"$ ",$JUSTIFY(ADJTOT(ADJ),9,2)

 +7                SET TOT=TOT+ADJTOT(ADJ)

               End DoDot:1

 +8        WRITE !,?67,"=========="

 +9        WRITE !,?65,"$ ",$JUSTIFY(TOT,9,2),!

 +10       QUIT

 +11      ; *********************************************************************

 +12      ;

EXIT      ; EP

 +1        KILL CNT,TOT,IND,ADJ,INDTOT,INDCNT

 +2        QUIT

 +3       ; *********************************************************************

 +4       ;

HEADER    ; EP

 +1        IF "S"=BARTYP

               QUIT

 +2        WRITE !,"E-Claim",?20,"Pat",?50,"DOSB",?65,"<P>ay"

 +3        IF BARTYP="D"

               WRITE !,?20,"HRN | HIC",?50,"DOSE",?65,"<B>ILL",!,?65,"<O>utstanding"

 +4        WRITE !

 +5        QUIT

 +6       ; *********************************************************************

 +7       ;

INDEX     ; EP

 +1        IF BARTYP'="S"

               WRITE !!,?3,BARZ(IND)

 +2        SET INDTOT(IND)=0

           SET INDCNT(IND)=0

           SET BARQUIT=0

 +3        SET CLMDA=0

 +4        FOR

               SET CLMDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,"AC",IND,CLMDA))

               IF CLMDA'>0

                   QUIT

               DO CLAIM

               IF $GET(BARQUIT)

                   QUIT

 +5        IF $GET(BARQUIT)

               QUIT

 +6        WRITE !,?3,BARZ(IND),?35,"TOTALS",?50,$JUSTIFY(INDCNT(IND),6,0),?65,"$ ",$JUSTIFY(INDTOT(IND),9,2)," <P>"

 +7        SET TOT=TOT+INDTOT(IND)

 +8        SET CNT=CNT+INDCNT(IND)

 +9        QUIT

 +10      ; *********************************************************************

 +11      ;

CLAIM     ;EP

 +1       ; WORK THE CLAIM

 +2        KILL CLM,ADJ

 +3        DO ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01:.09","CLM(")

 +4        SET INDTOT(IND)=INDTOT(IND)+CLM(.04)

           SET INDCNT(IND)=INDCNT(IND)+1

 +5        DO PRINT

 +6        IF "BS"'[BARTYP

               WRITE !

 +7        IF BARTYP="S"

               DO TOTADJ

 +8        QUIT

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

 +10      ;

TOTADJ    ;EP

 +1       ; for summary gather adj type totals

 +2        KILL ADJ

 +3        DO ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".02;.04","ADJ(")

 +4        NEW X,Y

 +5        SET I=0

 +6        FOR

               SET I=$ORDER(ADJ(I))

               IF I'>0

                   QUIT

               Begin DoDot:1

 +7                SET X=ADJ(I,.02)

 +8                SET Y=ADJ(I,.04)

 +9                IF Y=""

                       SET Y="?"

 +10               SET ADJTOT(Y)=$GET(ADJTOT(Y))+X

               End DoDot:1

 +11       QUIT

 +12      ; *********************************************************************

 +13      ;

PRINT     ; EP

 +1       ; print Claim info

 +2        IF BARTYP="S"

               QUIT

 +3        DO BARPG

 +4        IF $GET(BARQUIT)

               QUIT

 +5        WRITE !,CLM(.01),?20,$EXTRACT(CLM(.06),1,25),?50,$EXTRACT(CLM(.08),1,12),?65,"$ ",$JUSTIFY(CLM(.04),9,2)," <P>"

 +6        IF BARTYP="B"

               QUIT

 +7        WRITE !,?20,CLM(.07),?50,CLM(.09),?63,?65,"$ ",$JUSTIFY(CLM(.05),9,2)," <B>"

 +8        KILL ADJ

 +9        DO BARPG

           IF $GET(BARQUIT)

               QUIT

 +10       DO ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".01:.05","ADJ(")

 +11       FOR ADJ=1:1

               IF '$DATA(ADJ(ADJ))

                   QUIT

               Begin DoDot:1

 +12               WRITE !,?9,"$",$JUSTIFY(ADJ(ADJ,.02),8,2),?20,ADJ(ADJ,.03)

 +13               IF "RX"[BARTYP

                       QUIT

 +14               WRITE !,?20,ADJ(ADJ,.04),?50,ADJ(ADJ,.05)

               End DoDot:1

 +15       IF "MPN"[IND

               DO ARINFO

 +16       QUIT

 +17      ; *********************************************************************

 +18      ;

ARINFO    ; EP

 +1       ; PRINT A/R INFO

 +2        SET DFN=$$VALI^XBDIQ1(90056.0205,"IMPDA,CLMDA",1.01)

 +3        IF 'DFN

               QUIT

 +4        DO ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA","1.01:1.07","CLM(")

 +5        WRITE !,?15,"AR",?20,$EXTRACT(CLM(1.03),1,25),?50,$EXTRACT(CLM(1.05),1,12),?65,"$ ",$JUSTIFY(CLM(1.07),9,2)," <O>"

 +6        WRITE !,?20,CLM(1.04),?50,$EXTRACT(CLM(1.06),1,12),?65,"$ ",$JUSTIFY(CLM(1.02),9,2)," <B>"

 +7       ;

END       ;

 +1        QUIT

 +2       ; *********************************************************************

 +3       ;

BARPG     ;EP

 +1       ; PAGE CONTROLLER

 +2       ; this utility uses variables BARPG("HDR"),BARPG("DT"),BARPG("LINE"),BARPG("PG")

 +3       ; kill variables by D EBARPG

 +4       ;

 +5        IF ($Y<(IOSL-5))!($GET(DOUT)!$GET(DFOUT))

               QUIT

 +6        IF '$DATA(BARPG("PG"))

               SET BARPG("PG")=0

 +7        SET BARPG("PG")=BARPG("PG")+1

 +8        IF $EXTRACT(IOST)="C"

               IF IOT["TRM"

                   DO EOP^BARUTL(0)

 +9        IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

               SET BARQUIT=1

 +10      ;

Q         ;

 +1        IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

               QUIT

 +2       ;

BARHDR    ; EP

 +1       ; write page header

 +2        IF $Y

               WRITE @IOF

 +3        WRITE !

 +4        IF '$DATA(BARPG("HDR"))

               QUIT

 +5        IF '$DATA(BARPG("LINE"))

               SET $PIECE(BARPG("LINE"),"-",IOM-2)=""

 +6        IF '$DATA(BARPG("PG"))

               SET BARPG("PG")=1

 +7        IF '$DATA(BARPG("DT"))

               Begin DoDot:1

 +8                SET %H=$HOROLOG

 +9                DO YX^%DTC

 +10               SET BARPG("DT")=Y

               End DoDot:1

 +11       USE IO

 +12       WRITE ?(IOM-40-$LENGTH(BARPG("HDR"))/2),BARPG("HDR")

 +13       WRITE ?(IOM-40),BARPG("DT")

 +14       WRITE ?(IOM-10),"PAGE: ",BARPG("PG")

 +15       WRITE !,BARPG("LINE")

 +16      ;

BARHD     ; EP

 +1       ; Write column header / message

 +2        IF "S"=BARTYP

               QUIT

 +3        WRITE !,"E-Claim",?20,"Pat",?50,"DOSB",?65,"$    <P>ay"

 +4        IF BARTYP="D"

               WRITE !,?20,"HRN | HIC",?50,"DOSE",?65,"$    <B>ill",!,?65,"$    <O>ut"

 +5        QUIT

 +6       ; *********************************************************************

 +7       ;

 +8        IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

               SET BARQUIT=1

 +9        QUIT

 +10      ; *********************************************************************

 +11      ;

EBARPG    ;

 +1        KILL BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")

 +2        QUIT

BAR50P07.m