ABMESTAT ; IHS/SD/SDR - Bills Export Statistical Report;
;;2.6;IHS Third Party Billing System;**3,10,11**;NOV 12, 2009;Build 133
; IHS/SD/SDR - abm*2.6*3 - MU - new routine
;
K ABM,ABMY
S ABM("NODX")=""
;
D ^XBFMK
S DIR(0)="S^1:Summarized Report by ALLOWANCE CATEGORY;2:Summarized Report by INSURER;3:Summarized Report by INSURER TYPE"
S DIR("A")="Select the desired REPORT TYPE: "
S DIR("B")="1"
D ^DIR K DIR
S ABM("SRT")=$S(Y=2:"I",Y=3:"T",1:"A")
S ABM("DT")="A"
S ABM("DT",1)=3090101
S ABM("DT",2)=DT
;
SEL ;
D ^ABMDRSEL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("HD",0)="BILLS Export Statistical Report"
D ^ABMDRHD
S ABMQ("RC")="COMPUTE^ABMESTAT"
S ABMQ("RX")="POUT^ABMDRUTL"
S ABMQ("NS")="ABM"
S ABMQ("RP")="PRINT^ABMESTAT"
D ^ABMDRDBQ
Q
;
COMPUTE ;EP - Entry Point for Setting up Data
S ABM("SUBR")="ABM-ES" K ^TMP("ABM-ES",$J) S ABM("PG")=0
SLOOP I $D(ABMY("DT")) D Q
.S ABM("RD")=ABMY("DT",1)-1
.S ABMY("DT",2)=ABMY("DT",2)_".999999"
.I ABMY("DT")="A" D Q
..F S ABM("RD")=$O(^ABMDBILL(DUZ(2),"AP",ABM("RD"))) Q:'+ABM("RD")!(ABM("RD")>ABMY("DT",2)) D
...S ABM="" F S ABM=$O(^ABMDBILL(DUZ(2),"AP",ABM("RD"),ABM)) Q:'ABM D DATA
.I ABMY("DT")="V" D Q
..S ABMVDFN=0
..F S ABMVDFN=$O(^ABMDBILL(DUZ(2),"AV",ABMVDFN)) Q:'ABMVDFN D
...S ABMVDT=$P($P($G(^AUPNVSIT(ABMVDFN,0)),U),".")
...I (ABMVDT<ABMY("DT",1)!(ABMVDT>ABMY("DT",2))) Q
...S ABM="" F S ABM=$O(^ABMDBILL(DUZ(2),"AV",ABMVDFN,ABM)) Q:'ABM D DATA
.S ABMXMT=0
.F S ABMXMT=$O(^ABMDBILL(DUZ(2),"AX",ABMXMT)) Q:'ABMXMT D
..S ABMXDT=$P($P($G(^ABMDTXST(DUZ(2),ABMXMT,0)),U),".")
..I (ABMXDT<ABMY("DT",1)!(ABMXDT>ABMY("DT",2))) Q
..S ABM=0 F S ABM=$O(^ABMDBILL(DUZ(2),"AX",ABMXMT,ABM)) Q:'ABM D DATA
;
S ABM=0
F S ABM=$O(^ABMDBILL(DUZ(2),ABM)) Q:'ABM D DATA
Q
;
DATA ;
S ABMP("HIT")=0 D BILL^ABMDRCHK Q:'ABMP("HIT")
I ABM("SRT")="I" S ABM("SORT")=$P($G(^AUTNINS(ABM("I"),0)),U)
I ABM("SRT")="T" D
.;S ABM("SORT")=$$GET1^DIQ(9999999.18,ABM("I"),".21","E") ;abm*2.6*10 HEAT73780
.S ABM("SORT")=$$GET1^DIQ(9999999.18,ABM("I"),".211","E") ;abm*2.6*10 HEAT73780
;I ABM("SRT")="A" S ABM("SORT")=$P($T(@($P(^AUTNINS(ABM("I"),2),U))),";;",2) ;abm*2.6*10 HEAT73780
I ABM("SRT")="A" S ABM("SORT")=$P($T(@($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("I"),".211","I"),1,"I"))),";;",2) ;abm*2.6*10 HEAT73780
S ABM("L")=$P(^DIC(4,ABM("L"),0),U)
S ABM("EXP")=$P($G(^ABMDBILL(DUZ(2),ABM,0)),U,6)
S:$G(ABM("EXP"))="" ABM("EXP")="MANUAL BILL W/O EXPORT MODE" ;no export mode--manual bill
S:($G(^TMP("ABM-ES",$J,ABM("L"),ABM("EXP"),ABM("SORT")))="") ^TMP("ABM-ES",$J,ABM("L"),ABM("EXP"),ABM("SORT"))=ABM("L")_U_ABM("EXP")_U_ABM("SORT")
S $P(^TMP("ABM-ES",$J,ABM("L"),ABM("EXP"),ABM("SORT")),U,4)=+$P($G(^TMP("ABM-ES",$J,ABM("L"),ABM("EXP"),ABM("SORT"))),U,4)+1 ;number bills
S $P(^TMP("ABM-ES",$J,ABM("L"),ABM("EXP"),ABM("SORT")),U,5)=+$P($G(^TMP("ABM-ES",$J,ABM("L"),ABM("EXP"),ABM("SORT"))),U,5)+$P($G(^ABMDBILL(DUZ(2),ABM,2)),U) ;total
Q
PRINT ;
S ABM("TXT")=""
S ABM("PG")=0
D HDB
S (ABM("SUBCNT"),ABM("SUBAMT"))=0,(ABM("EXP"),ABM("V"))=""
S (ABM("TCNT"),ABM("TAMT"))=0
S ABM("A")="TMP(""ABM-ES"","_$J
S ABM="^"_ABM("A")_")" I '$D(@ABM) Q
;
F S ABM=$Q(@ABM) Q:ABM'[ABM("A") D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.S ABM("TCNT")=ABM("TCNT")+$P($G(@ABM),U,4)
;
S ABM="^"_ABM("A")_")" I '$D(@ABM) Q
F S ABM=$Q(@ABM) Q:ABM'[ABM("A") D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) D EXP W " (cont)"
.S ABM("TXT")=$G(@ABM)
.I ABM("EXP")'=$P(ABM("TXT"),U,2) S ABM("V")="" D SUB,EXP
.S ABM("EXP")=$P(ABM("TXT"),U,2)
.W !?10,$P(ABM("TXT"),U,3)
.W ?40,$J($P(ABM("TXT"),U,4),"6R")
.W ?64,$J($FN($P(ABM("TXT"),U,5),",",2),"12R")
.S ABM("SUBCNT")=ABM("SUBCNT")+$P(ABM("TXT"),U,4)
.S ABM("TAMT")=ABM("TAMT")+$P(ABM("TXT"),U,5),ABM("SUBAMT")=ABM("SUBAMT")+$P(ABM("TXT"),U,5)
Q:$D(DIROUT)!($D(DUOUT))!($D(DTOUT))
D SUB
W !!?40,"======",?64,"============"
W !?20,"Total:",?40,$J(ABM("TCNT"),"6R"),?64,$J($FN(ABM("TAMT"),",",2),"12R")
Q
;
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB S ABM("PG")=ABM("PG")+1 D WHD^ABMDRHD
W !?40,"Number"
W !?10,$S(ABM("SRT")="I":"Insurer",ABM("SRT")="A":"Allowance Category",1:"Insurer Type")
W ?40,"Bills",?53,"Percent",?68,"Total"
S $P(ABM("LINE"),"-",80)="" W !,ABM("LINE") K ABM("LINE")
Q
;
EXP W !!?3,"Export Mode: "_$S(+$P(ABM("TXT"),U,2):$P($G(^ABMDEXP($P(ABM("TXT"),U,2),0)),U),1:$P(ABM("TXT"),U,2))
Q
;
SUB Q:'ABM("SUBCNT")
W !?40,"------",?64,"------------"
W !?20,"Subtotal:",?40,$J(ABM("SUBCNT"),"6R"),?55,$J((ABM("SUBCNT")/ABM("TCNT")*100),".",1),?64,$J($FN(ABM("SUBAMT"),",",2),"12R")
S ABM("SUBCNT")=0,ABM("SUBAMT")=0
Q
;abm*2.6*11 VMBP#4
TXT ;
H ;;PRIVATE
M ;;PRIVATE
D ;;MEDICAID
R ;;MEDICARE
P ;;PRIVATE
W ;;OTHER
C ;;OTHER
F ;;PRIVATE
N ;;OTHER
I ;;OTHER
K ;;MEDICAID
T ;;OTHER
G ;;OTHER
MD ;;MEDICARE
MH ;;MEDICARE
V ;;VMBP
ABMESTAT ; IHS/SD/SDR - Bills Export Statistical Report;
+1 ;;2.6;IHS Third Party Billing System;**3,10,11**;NOV 12, 2009;Build 133
+2 ; IHS/SD/SDR - abm*2.6*3 - MU - new routine
+3 ;
+4 KILL ABM,ABMY
+5 SET ABM("NODX")=""
+6 ;
+7 DO ^XBFMK
+8 SET DIR(0)="S^1:Summarized Report by ALLOWANCE CATEGORY;2:Summarized Report by INSURER;3:Summarized Report by INSURER TYPE"
+9 SET DIR("A")="Select the desired REPORT TYPE: "
+10 SET DIR("B")="1"
+11 DO ^DIR
KILL DIR
+12 SET ABM("SRT")=$SELECT(Y=2:"I",Y=3:"T",1:"A")
+13 SET ABM("DT")="A"
+14 SET ABM("DT",1)=3090101
+15 SET ABM("DT",2)=DT
+16 ;
SEL ;
+1 DO ^ABMDRSEL
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+2 SET ABM("HD",0)="BILLS Export Statistical Report"
+3 DO ^ABMDRHD
+4 SET ABMQ("RC")="COMPUTE^ABMESTAT"
+5 SET ABMQ("RX")="POUT^ABMDRUTL"
+6 SET ABMQ("NS")="ABM"
+7 SET ABMQ("RP")="PRINT^ABMESTAT"
+8 DO ^ABMDRDBQ
+9 QUIT
+10 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 SET ABM("SUBR")="ABM-ES"
KILL ^TMP("ABM-ES",$JOB)
SET ABM("PG")=0
SLOOP IF $DATA(ABMY("DT"))
Begin DoDot:1
+1 SET ABM("RD")=ABMY("DT",1)-1
+2 SET ABMY("DT",2)=ABMY("DT",2)_".999999"
+3 IF ABMY("DT")="A"
Begin DoDot:2
+4 FOR
SET ABM("RD")=$ORDER(^ABMDBILL(DUZ(2),"AP",ABM("RD")))
IF '+ABM("RD")!(ABM("RD")>ABMY("DT",2))
QUIT
Begin DoDot:3
+5 SET ABM=""
FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AP",ABM("RD"),ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:3
End DoDot:2
QUIT
+6 IF ABMY("DT")="V"
Begin DoDot:2
+7 SET ABMVDFN=0
+8 FOR
SET ABMVDFN=$ORDER(^ABMDBILL(DUZ(2),"AV",ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:3
+9 SET ABMVDT=$PIECE($PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),".")
+10 IF (ABMVDT<ABMY("DT",1)!(ABMVDT>ABMY("DT",2)))
QUIT
+11 SET ABM=""
FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AV",ABMVDFN,ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:3
End DoDot:2
QUIT
+12 SET ABMXMT=0
+13 FOR
SET ABMXMT=$ORDER(^ABMDBILL(DUZ(2),"AX",ABMXMT))
IF 'ABMXMT
QUIT
Begin DoDot:2
+14 SET ABMXDT=$PIECE($PIECE($GET(^ABMDTXST(DUZ(2),ABMXMT,0)),U),".")
+15 IF (ABMXDT<ABMY("DT",1)!(ABMXDT>ABMY("DT",2)))
QUIT
+16 SET ABM=0
FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),"AX",ABMXMT,ABM))
IF 'ABM
QUIT
DO DATA
End DoDot:2
End DoDot:1
QUIT
+17 ;
+18 SET ABM=0
+19 FOR
SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABM))
IF 'ABM
QUIT
DO DATA
+20 QUIT
+21 ;
DATA ;
+1 SET ABMP("HIT")=0
DO BILL^ABMDRCHK
IF 'ABMP("HIT")
QUIT
+2 IF ABM("SRT")="I"
SET ABM("SORT")=$PIECE($GET(^AUTNINS(ABM("I"),0)),U)
+3 IF ABM("SRT")="T"
Begin DoDot:1
+4 ;S ABM("SORT")=$$GET1^DIQ(9999999.18,ABM("I"),".21","E") ;abm*2.6*10 HEAT73780
+5 ;abm*2.6*10 HEAT73780
SET ABM("SORT")=$$GET1^DIQ(9999999.18,ABM("I"),".211","E")
End DoDot:1
+6 ;I ABM("SRT")="A" S ABM("SORT")=$P($T(@($P(^AUTNINS(ABM("I"),2),U))),";;",2) ;abm*2.6*10 HEAT73780
+7 ;abm*2.6*10 HEAT73780
IF ABM("SRT")="A"
SET ABM("SORT")=$PIECE($TEXT(@($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("I"),".211","I"),1,"I"))),";;",2)
+8 SET ABM("L")=$PIECE(^DIC(4,ABM("L"),0),U)
+9 SET ABM("EXP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABM,0)),U,6)
+10 ;no export mode--manual bill
IF $GET(ABM("EXP"))=""
SET ABM("EXP")="MANUAL BILL W/O EXPORT MODE"
+11 IF ($GET(^TMP("ABM-ES",$JOB,ABM("L"),ABM("EXP"),ABM("SORT")))="")
SET ^TMP("ABM-ES",$JOB,ABM("L"),ABM("EXP"),ABM("SORT"))=ABM("L")_U_ABM("EXP")_U_ABM("SORT")
+12 ;number bills
SET $PIECE(^TMP("ABM-ES",$JOB,ABM("L"),ABM("EXP"),ABM("SORT")),U,4)=+$PIECE($GET(^TMP("ABM-ES",$JOB,ABM("L"),ABM("EXP"),ABM("SORT"))),U,4)+1
+13 ;total
SET $PIECE(^TMP("ABM-ES",$JOB,ABM("L"),ABM("EXP"),ABM("SORT")),U,5)=+$PIECE($GET(^TMP("ABM-ES",$JOB,ABM("L"),ABM("EXP"),ABM("SORT"))),U,5)+$PIECE($GET(^ABMDBILL(DUZ(2),ABM,2)),U)
+14 QUIT
PRINT ;
+1 SET ABM("TXT")=""
+2 SET ABM("PG")=0
+3 DO HDB
+4 SET (ABM("SUBCNT"),ABM("SUBAMT"))=0
SET (ABM("EXP"),ABM("V"))=""
+5 SET (ABM("TCNT"),ABM("TAMT"))=0
+6 SET ABM("A")="TMP(""ABM-ES"","_$JOB
+7 SET ABM="^"_ABM("A")_")"
IF '$DATA(@ABM)
QUIT
+8 ;
+9 FOR
SET ABM=$QUERY(@ABM)
IF ABM'[ABM("A")
QUIT
Begin DoDot:1
+10 SET ABM("TCNT")=ABM("TCNT")+$PIECE($GET(@ABM),U,4)
End DoDot:1
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+11 ;
+12 SET ABM="^"_ABM("A")_")"
IF '$DATA(@ABM)
QUIT
+13 FOR
SET ABM=$QUERY(@ABM)
IF ABM'[ABM("A")
QUIT
Begin DoDot:1
+14 IF $Y>(IOSL-5)
DO HD
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
DO EXP
WRITE " (cont)"
+15 SET ABM("TXT")=$GET(@ABM)
+16 IF ABM("EXP")'=$PIECE(ABM("TXT"),U,2)
SET ABM("V")=""
DO SUB
DO EXP
+17 SET ABM("EXP")=$PIECE(ABM("TXT"),U,2)
+18 WRITE !?10,$PIECE(ABM("TXT"),U,3)
+19 WRITE ?40,$JUSTIFY($PIECE(ABM("TXT"),U,4),"6R")
+20 WRITE ?64,$JUSTIFY($FNUMBER($PIECE(ABM("TXT"),U,5),",",2),"12R")
+21 SET ABM("SUBCNT")=ABM("SUBCNT")+$PIECE(ABM("TXT"),U,4)
+22 SET ABM("TAMT")=ABM("TAMT")+$PIECE(ABM("TXT"),U,5)
SET ABM("SUBAMT")=ABM("SUBAMT")+$PIECE(ABM("TXT"),U,5)
End DoDot:1
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
+23 IF $DATA">DATA">DATA">DATA(DIROUT)!($DATA">DATA">DATA">DATA(DUOUT))!($DATA">DATA">DATA">DATA(DTOUT))
QUIT
+24 DO SUB
+25 WRITE !!?40,"======",?64,"============"
+26 WRITE !?20,"Total:",?40,$JUSTIFY(ABM("TCNT"),"6R"),?64,$JUSTIFY($FNUMBER(ABM("TAMT"),",",2),"12R")
+27 QUIT
+28 ;
HD DO PAZ^ABMDRUTL
IF $DATA">DATA">DATA">DATA(DTOUT)!$DATA">DATA">DATA">DATA(DUOUT)!$DATA">DATA">DATA">DATA(DIROUT)
QUIT
HDB SET ABM("PG")=ABM("PG")+1
DO WHD^ABMDRHD
+1 WRITE !?40,"Number"
+2 WRITE !?10,$SELECT(ABM("SRT")="I":"Insurer",ABM("SRT")="A":"Allowance Category",1:"Insurer Type")
+3 WRITE ?40,"Bills",?53,"Percent",?68,"Total"
+4 SET $PIECE(ABM("LINE"),"-",80)=""
WRITE !,ABM("LINE")
KILL ABM("LINE")
+5 QUIT
+6 ;
EXP WRITE !!?3,"Export Mode: "_$SELECT(+$PIECE(ABM("TXT"),U,2):$PIECE($GET(^ABMDEXP($PIECE(ABM("TXT"),U,2),0)),U),1:$PIECE(ABM("TXT"),U,2))
+1 QUIT
+2 ;
SUB IF 'ABM("SUBCNT")
QUIT
+1 WRITE !?40,"------",?64,"------------"
+2 WRITE !?20,"Subtotal:",?40,$JUSTIFY(ABM("SUBCNT"),"6R"),?55,$JUSTIFY((ABM("SUBCNT")/ABM("TCNT")*100),".",1),?64,$JUSTIFY($FNUMBER(ABM("SUBAMT"),",",2),"12R")
+3 SET ABM("SUBCNT")=0
SET ABM("SUBAMT")=0
+4 QUIT
+5 ;abm*2.6*11 VMBP#4
TXT ;
H ;;PRIVATE
M ;;PRIVATE
D ;;MEDICAID
R ;;MEDICARE
P ;;PRIVATE
W ;;OTHER
C ;;OTHER
F ;;PRIVATE
N ;;OTHER
I ;;OTHER
K ;;MEDICAID
T ;;OTHER
G ;;OTHER
MD ;;MEDICARE
MH ;;MEDICARE
V ;;VMBP
