ABMDRDX.m

ABMDRDX ; IHS/ASDST/DMJ - DX Summary Report ;

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

 ;Original;TMD;

 ;

 ;IHS/SD/SDR - v2.6 CSV

 ;IHS/SD/SDR - 2.6*14 - ICD10 009 - Correct to report found while coding for ICD10. was using code,

 ;   not IEN so any codes starting with alpha wouldn't print.

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

 ;IHS/SD/SDR - 2.6*21 - HEAT112272, HEAT167616 - Made correction so report would store and sort by DX code, not by IEN.

 ;

 K ABM,ABMY

 D ^ABMDRSEL G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)

HD S ABM("HD",0)="BILLED PRIMARY DIAGNOSIS" D ^ABMDRHD

 S ABMQ("RC")="COMPUTE^ABMDRDX",ABMQ("RP")="PRINT^ABMDRDX1",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM"

 D ^ABMDRDBQ

 Q

 ;

COMPUTE ;EP - Entry Point for Setting up Data

 S ABM("SUBR")="ABM-DX" K ^TMP(ABM("SUBR"),$J)

 S ABMP("RTN")="ABMDRDX" D LOOP^ABMDRUTL

 Q

 ;

DATA S ABMP("HIT")=0 D ^ABMDRCHK Q:'ABMP("HIT")

 S ABM("DX")=$O(^ABMDBILL(DUZ(2),ABM,17,"C",0)) Q:'ABM("DX")

 S ABM("DX")=$O(^ABMDBILL(DUZ(2),ABM,17,"C",ABM("DX"),0)) Q:'ABM("DX")

 Q:'$D(^ABMDBILL(DUZ(2),ABM,17,ABM("DX"),0))  S ABM("DX")=+^(0)

 S ABM("BL")=+^ABMDBILL(DUZ(2),ABM,2)

TL S:'$D(^TMP("ABM-DX",$J)) ^TMP("ABM-DX",$J)=0_U_0

 S $P(^TMP("ABM-DX",$J),U)=$P(^($J),U)+1,$P(^($J),U,2)=$P(^($J),U,2)+ABM("BL")

 ;S ABM("CD")=+$P($$DX^ABMCVAPI(ABM("DX"),ABM("D")),U,2)  ;CSV-c  ;abm*2.6*14 ICD10 009

 ;S ABM("CD")=+$P($$DX^ABMCVAPI(ABM("DX"),ABM("D")),U)  ;CSV-c  ;abm*2.6*14 ICD10 009  ;abm*2.6*21 IHS/SD/SDR HEAT167616

 S ABM("CD")=""""_$P($$DX^ABMCVAPI(ABM("DX"),ABM("D")),U,2)_""""  ;CSV-c  ;abm*2.6*14 ICD10 009  ;abm*2.6*21 IHS/SD/SDR HEAT167616

 S:'$D(^TMP("ABM-DX",$J,ABM("CD"),ABM("DX"))) ^TMP("ABM-DX",$J,ABM("CD"),ABM("DX"))=0_U_0

 S $P(^TMP("ABM-DX",$J,ABM("CD"),ABM("DX")),U)=$P(^TMP("ABM-DX",$J,ABM("CD"),ABM("DX")),U)+1,$P(^(ABM("DX")),U,2)=$P(^(ABM("DX")),U,2)+ABM("BL")

 Q

 ;

XIT K ABM,ABMY,ABMP

 Q

ABMDRDX   ; IHS/ASDST/DMJ - DX Summary Report ;

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

 +2       ;Original;TMD;

 +3       ;

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

 +5       ;IHS/SD/SDR - 2.6*14 - ICD10 009 - Correct to report found while coding for ICD10. was using code,

 +6       ;   not IEN so any codes starting with alpha wouldn't print.

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

 +8       ;IHS/SD/SDR - 2.6*21 - HEAT112272, HEAT167616 - Made correction so report would store and sort by DX code, not by IEN.

 +9       ;

 +10       KILL ABM,ABMY

 +11       DO ^ABMDRSEL

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

               GOTO XIT

HD         SET ABM("HD",0)="BILLED PRIMARY DIAGNOSIS"

           DO ^ABMDRHD

 +1        SET ABMQ("RC")="COMPUTE^ABMDRDX"

           SET ABMQ("RP")="PRINT^ABMDRDX1"

           SET ABMQ("RX")="POUT^ABMDRUTL"

           SET ABMQ("NS")="ABM"

 +2        DO ^ABMDRDBQ

 +3        QUIT 

 +4       ;

COMPUTE   ;EP - Entry Point for Setting up Data

 +1        SET ABM("SUBR")="ABM-DX"

           KILL ^TMP(ABM("SUBR"),$JOB)

 +2        SET ABMP("RTN")="ABMDRDX"

           DO LOOP^ABMDRUTL

 +3        QUIT 

 +4       ;

DATA       SET ABMP("HIT")=0

           DO ^ABMDRCHK

           IF 'ABMP("HIT")

               QUIT 

 +1        SET ABM("DX")=$ORDER(^ABMDBILL(DUZ(2),ABM,17,"C",0))

           IF 'ABM("DX")

               QUIT 

 +2        SET ABM("DX")=$ORDER(^ABMDBILL(DUZ(2),ABM,17,"C",ABM("DX"),0))

           IF 'ABM("DX")

               QUIT 

 +3        IF '$DATA(^ABMDBILL(DUZ(2),ABM,17,ABM("DX"),0))

               QUIT 

           SET ABM("DX")=+^(0)

 +4        SET ABM("BL")=+^ABMDBILL(DUZ(2),ABM,2)

TL         IF '$DATA(^TMP("ABM-DX",$JOB))

               SET ^TMP("ABM-DX",$JOB)=0_U_0

 +1        SET $PIECE(^TMP("ABM-DX",$JOB),U)=$PIECE(^($JOB),U)+1

           SET $PIECE(^($JOB),U,2)=$PIECE(^($JOB),U,2)+ABM("BL")

 +2       ;S ABM("CD")=+$P($$DX^ABMCVAPI(ABM("DX"),ABM("D")),U,2)  ;CSV-c  ;abm*2.6*14 ICD10 009

 +3       ;S ABM("CD")=+$P($$DX^ABMCVAPI(ABM("DX"),ABM("D")),U)  ;CSV-c  ;abm*2.6*14 ICD10 009  ;abm*2.6*21 IHS/SD/SDR HEAT167616

 +4       ;CSV-c  ;abm*2.6*14 ICD10 009  ;abm*2.6*21 IHS/SD/SDR HEAT167616

           SET ABM("CD")=""""_$PIECE($$DX^ABMCVAPI(ABM("DX"),ABM("D")),U,2)_""""

 +5        IF '$DATA(^TMP("ABM-DX",$JOB,ABM("CD"),ABM("DX")))

               SET ^TMP("ABM-DX",$JOB,ABM("CD"),ABM("DX"))=0_U_0

 +6        SET $PIECE(^TMP("ABM-DX",$JOB,ABM("CD"),ABM("DX")),U)=$PIECE(^TMP("ABM-DX",$JOB,ABM("CD"),ABM("DX")),U)+1

           SET $PIECE(^(ABM("DX")),U,2)=$PIECE(^(ABM("DX")),U,2)+ABM("BL")

 +7        QUIT 

 +8       ;

XIT        KILL ABM,ABMY,ABMP

 +1        QUIT