ABMDRDX1.m

ABMDRDX1 ; IHS/ASDST/DMJ - Billed DX List ;

 ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238

 ;Original;TMD;

 ;

 ; IHS/SD/SDR - v2.6 CSV

 ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric

 ;IHS/SD/SDR - 2.6*14 - removed '9' from ICD9 in header

 ;IHS/SD/SDR - 2.6*14 - HEAT165197 - Shortened desc to 31 characters to stop wrapping

 ;

PRINT ;EP for printing data

 W:$D(ABM("PRINT",16)) @ABM("PRINT",16) S ABM("PG")=0 D HDB

 S ABM("O")=0 F  S ABM("O")=$O(^TMP("ABM-DX",$J,ABM("O"))) Q:ABM("O")=""  D  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)

 .S ABM=$O(^TMP("ABM-DX",$J,ABM("O"),0)) Q:ABM=""  S ABM("T")=^(ABM)

 .I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)

 .D WRT

 Q:$D(DTOUT)!($D(DUOUT))!($D(DIROUT))

 S ABM("T")=$G(^TMP("ABM-DX",$J))

 W !?41,"+=======+=============+"

 W !,"Primary Diagnosis Total",?43,$J($FN($P(ABM("T"),U),",",0),5),?51,$J($FN($P(ABM("T"),U,2),",",2),11)

 W !?41,"+=======+=============+"

 Q

 ;

WRT ;

 ;W !?2,$P($$DX^ABMCVAPI(ABM,ABM("D")),U,2),?10,$P($$DX^ABMCVAPI(ABM,ABM("D")),U,4)  ;CSV-c  ;abm*2.6*14 updated API call

 W !?2,$P($$DX^ABMCVAPI(+ABM,ABM("D")),U,2),?10,$E($P($$DX^ABMCVAPI(+ABM,ABM("D")),U,4),1,31)  ;CSV-c  ;abm*2.6*14 updated API call and HEAT165197

 W ?43,$J($FN($P(ABM("T"),U),",",0),5),?51,$J($FN($P(ABM("T"),U,2),",",2),11)

 W ?66,$J((100*$P(ABM("T"),U))\+^TMP("ABM-DX",$J),2),"%"

 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 !?2,"ICD9"  ;ABM*2.6*14 remove '9' so its good for both code sets

 W !?2,"ICD"  ;ABM*2.6*14

 W !?2,"Code",?14,"Diagnosis Description",?43,"Bills",?53,"Amount",?64,"Percent"

 W !,"+-------+--------------------------------+-------+-------------+-------+"

 Q

ABMDRDX1  ; IHS/ASDST/DMJ - Billed DX List ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238

 +2       ;Original;TMD;

 +3       ;

 +4       ; IHS/SD/SDR - v2.6 CSV

 +5       ;IHS/SD/SDR - 2.6*14 - Updated DX^ABMCVAPI call to be numeric

 +6       ;IHS/SD/SDR - 2.6*14 - removed '9' from ICD9 in header

 +7       ;IHS/SD/SDR - 2.6*14 - HEAT165197 - Shortened desc to 31 characters to stop wrapping

 +8       ;

PRINT     ;EP for printing data

 +1        IF $DATA(ABM("PRINT",16))

               WRITE @ABM("PRINT",16)

           SET ABM("PG")=0

           DO HDB

 +2        SET ABM("O")=0

           FOR 

               SET ABM("O")=$ORDER(^TMP("ABM-DX",$JOB,ABM("O")))

               IF ABM("O")=""

                   QUIT 

               Begin DoDot:1

 +3                SET ABM=$ORDER(^TMP("ABM-DX",$JOB,ABM("O"),0))

                   IF ABM=""

                       QUIT 

                   SET ABM("T")=^(ABM)

 +4                IF $Y>(IOSL-5)

                       DO HD

                       IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

                           QUIT 

 +5                DO WRT

               End DoDot:1

               IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

                   QUIT 

 +6        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))

               QUIT 

 +7        SET ABM("T")=$GET(^TMP("ABM-DX",$JOB))

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

 +9        WRITE !,"Primary Diagnosis Total",?43,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U),",",0),5),?51,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U,2),",",2),11)

 +10       WRITE !?41,"+=======+=============+"

 +11       QUIT 

 +12      ;

WRT       ;

 +1       ;W !?2,$P($$DX^ABMCVAPI(ABM,ABM("D")),U,2),?10,$P($$DX^ABMCVAPI(ABM,ABM("D")),U,4)  ;CSV-c  ;abm*2.6*14 updated API call

 +2       ;CSV-c  ;abm*2.6*14 updated API call and HEAT165197

           WRITE !?2,$PIECE($$DX^ABMCVAPI(+ABM,ABM("D")),U,2),?10,$EXTRACT($PIECE($$DX^ABMCVAPI(+ABM,ABM("D")),U,4),1,31)

 +3        WRITE ?43,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U),",",0),5),?51,$JUSTIFY($FNUMBER($PIECE(ABM("T"),U,2),",",2),11)

 +4        WRITE ?66,$JUSTIFY((100*$PIECE(ABM("T"),U))\+^TMP("ABM-DX",$JOB),2),"%"

 +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       ;W !?2,"ICD9"  ;ABM*2.6*14 remove '9' so its good for both code sets

 +2       ;ABM*2.6*14

           WRITE !?2,"ICD"

 +3        WRITE !?2,"Code",?14,"Diagnosis Description",?43,"Bills",?53,"Amount",?64,"Percent"

 +4        WRITE !,"+-------+--------------------------------+-------+-------------+-------+"

 +5        QUIT