- ABMDRPX1 ; IHS/ASDST/DMJ - Billed CPT List ;
- ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
- ;Original;TMD;
- ; IHS/SD/SDR - abm*2.6*1 - HEAT4716 - Allowed room for NDC
- ;
- PRINT ;EP for printing data
- W:$D(ABM("PRINT",16)) @ABM("PRINT",16) S ABM("PG")=0 D HDB
- S ABM="" F S ABM=$O(^TMP("ABM-PX",$J,ABM)) Q:ABM="" S ABM("T")=^(ABM) D Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- .I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- .D WRT
- I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) K ^TMP("ABM-PX",$J,"CL") Q
- S ABM("T")=$G(^TMP("ABM-PX",$J))
- W !?50,"+=======+=============+"
- W !?43,"Total:",?52,$J($FN($P(ABM("T"),U),",",0),5),?60,$J($FN($P(ABM("T"),U,2),",",2),11)
- W !?50,"+=======+=============+"
- K ^TMP("ABM-PX",$J,"CL") Q
- ;
- WRT ;W !?1,$S(ABM="ZZZZZ":"",1:ABM),?9,$P(ABM("T"),U,3) ;abm*2.6*1 HEAT4716
- I ABM["-" W !?1,ABM,?20,$P(ABM("T"),U,3) ;abm*2.6*1 HEAT4716
- I ABM'["-" W !?1,$S(ABM="ZZZZZ":"",1:ABM),?9,$P(ABM("T"),U,3) ;abm*2.6*1 HEAT4716
- W ?52,$J($FN($P(ABM("T"),U),",",0),5),?60,$J($FN($P(ABM("T"),U,2),",",2),11)
- W ?74,$J($J(100*$P(ABM("T"),U,2)\$P(^TMP("ABM-PX",$J),U,2),".",1),4),"%"
- Q
- ;
- HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- HDB S ABM("PG")=ABM("PG")+1,ABM("I")="" D WHD^ABMDRHD
- W !?63,"Amount"
- ;start old code abm*2.6*1 HEAT4716
- ;W !?1,"Code",?17,"Procedure Description",?52,"Count",?63,"Billed",?73,"Percent"
- ;W !,"-------+------------------------------------------+-------+-------------+-------"
- ;end old code start new code HEAT4716
- I $G(ABM("SUB"))=23 D
- .W !?1,"Code",?20,"Procedure Description",?52,"Count",?63,"Billed",?73,"Percent"
- .W !,"-----------------+--------------------------------+-------+-------------+-------"
- I $G(ABM("SUB"))'=23 D
- .W !?1,"Code",?17,"Procedure Description",?52,"Count",?63,"Billed",?73,"Percent"
- .W !,"-------+------------------------------------------+-------+-------------+-------"
- ;end new code HEAT4716
- Q
- ABMDRPX1 ; IHS/ASDST/DMJ - Billed CPT List ;
- +1 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009
- +2 ;Original;TMD;
- +3 ; IHS/SD/SDR - abm*2.6*1 - HEAT4716 - Allowed room for NDC
- +4 ;
- PRINT ;EP for printing data
- +1 IF $DATA(ABM("PRINT",16))
- WRITE @ABM("PRINT",16)
- SET ABM("PG")=0
- DO HDB
- +2 SET ABM=""
- FOR
- SET ABM=$ORDER(^TMP("ABM-PX",$JOB,ABM))
- IF ABM=""
- QUIT
- SET ABM("T")=^(ABM)
- Begin DoDot:1
- +3 IF $Y>(IOSL-5)
- DO HD
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- +4 DO WRT
- End DoDot:1
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- +5 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
- KILL ^TMP("ABM-PX",$JOB,"CL")
- QUIT
- +6 SET ABM("T")=$GET(^TMP("ABM-PX",$JOB))
- +7 WRITE !?50,"+=======+=============+"
- +8 WRITE !?43,"Total:",?52,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U),",",0),5),?60,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U,2),",",2),11)
- +9 WRITE !?50,"+=======+=============+"
- +10 KILL ^TMP("ABM-PX",$JOB,"CL")
- QUIT
- +11 ;
- WRT ;W !?1,$S(ABM="ZZZZZ":"",1:ABM),?9,$P(ABM("T"),U,3) ;abm*2.6*1 HEAT4716
- +1 ;abm*2.6*1 HEAT4716
- IF ABM["-"
- WRITE !?1,ABM,?20,$PIECE(ABM("T"),U,3)
- +2 ;abm*2.6*1 HEAT4716
- IF ABM'["-"
- WRITE !?1,$SELECT(ABM="ZZZZZ":"",1:ABM),?9,$PIECE(ABM("T"),U,3)
- +3 WRITE ?52,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U),",",0),5),?60,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U,2),",",2),11)
- +4 WRITE ?74,$JUSTIFY($JUSTIFY(100*$PIECE(ABM("T"),U,2)\$PIECE(^TMP("ABM-PX",$JOB),U,2),".",1),4),"%"
- +5 QUIT
- +6 ;
- HD DO PAZ^ABMDRUTL
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- HDB SET ABM("PG")=ABM("PG")+1
- SET ABM("I")=""
- DO WHD^ABMDRHD
- +1 WRITE !?63,"Amount"
- +2 ;start old code abm*2.6*1 HEAT4716
- +3 ;W !?1,"Code",?17,"Procedure Description",?52,"Count",?63,"Billed",?73,"Percent"
- +4 ;W !,"-------+------------------------------------------+-------+-------------+-------"
- +5 ;end old code start new code HEAT4716
- +6 IF $GET(ABM("SUB"))=23
- Begin DoDot:1
- +7 WRITE !?1,"Code",?20,"Procedure Description",?52,"Count",?63,"Billed",?73,"Percent"
- +8 WRITE !,"-----------------+--------------------------------+-------+-------------+-------"
- End DoDot:1
- +9 IF $GET(ABM("SUB"))'=23
- Begin DoDot:1
- +10 WRITE !?1,"Code",?17,"Procedure Description",?52,"Count",?63,"Billed",?73,"Percent"
- +11 WRITE !,"-------+------------------------------------------+-------+-------------+-------"
- End DoDot:1
- +12 ;end new code HEAT4716
- +13 QUIT
