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 ;
Q
; *********************************************************************
;
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),!
Q
; *********************************************************************
;
EXIT ; EP
K CNT,TOT,IND,ADJ,INDTOT,INDCNT
Q
; *********************************************************************
;
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 !
Q
; *********************************************************************
;
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)
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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 ;
Q
; *********************************************************************
;
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"
Q
; *********************************************************************
;
I ($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT)) S BARQUIT=1
Q
; *********************************************************************
;
EBARPG ;
K BARPG("LINE"),BARPG("PG"),BARPG("HDR"),BARPG("DT")
Q
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 ;
+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
