- 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
