Routine: ABMDE9B

ABMDE9B ; IHS/ASDST/DMJ - Page 9 - UB-82 CODES-Cont ;

 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009

 ; IHS/SD/SDR - v2.5 p10 - IM20337

 ;   Added code for ADA formats

 ; IHS/SD/SDR - v2.5 p11 - NPI

 ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - added page 9G

DISP5 ;EP - Entry Point for Spec Prog code

 K ABMZ S ABMZ("TITL")="SPECIAL PROGRAM CODES",ABMZ("PG")="9E"

 I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1

 E  D SUM^ABMDE1

SPCL ; Special Program

 S ABMZ("SUB")=59,ABMZ("DR")="",ABMZ("ITEM")="Special Program Code",ABMZ("DIC")="^ABMDCODE(",ABMZ("X")="DINUM",ABMZ("MAX")=1

 D HD5 G LOOP5

HD5 W !?6,"PRGM"

 W !?6,"CODE",?14,"           SPECIAL PROGRAM DESCRIPTION"

 W !?6,"====",?14,"============================================================"

LOOP5 S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0,ABM=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM)) Q:'ABM  S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D SPCL1

 I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")

SPCL1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),0),ABM("X")=$P(^(0),U)

 S ABMZ(ABM("I"))=$E(("00"_$P(^ABMDCODE(ABM("X"),0),U)),$L($P(^(0),U))+1,4)_U_ABM_U_$P(ABM("X0"),U,2)

 I $Y>(IOSL-5) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT D HD5

 W !,"[",ABM("I"),"]",?7,$P(ABMZ(ABM("I")),U),?14,$P(^ABMDCODE(ABM("X"),0),U,3)

DISP6 ;EP - Entry Point for Remarks

 N I F I=1:1:4 D

 .Q:'$D(^ABMDEXP(ABMP("EXP"),2,I,0))

 .Q:$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,I,0))

 .S ^ABMDCLM(DUZ(2),ABMP("CDFN"),61,I,0)=^ABMDEXP(ABMP("EXP"),2,I,0)

 .S ^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0)="^^"_I_"^"_I_"^"_DT

 K ABMZ S ABMZ("TITL")="REMARKS",ABMZ("PG")="9F"

 I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1

 E  D SUM^ABMDE1

REM ; Remarks

 D HD6,REM1

 ;start new code abm*2.6*1 HEAT6439

DISP7 ;EP - Entry Point for Claim Attachments

 K ABMZ S ABMZ("TITL")="CLAIM ATTACHMENTS",ABMZ("PG")="9G"

 I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1

 E  D SUM^ABMDE1

CATTCH ; Claim Attachments

 S ABMZ("SUB")=71,ABMZ("DR")=";W !;.02Transmission Code//;.03Control Number//",ABMZ("ITEM")="Claim Attachment",ABMZ("DIC")="^ABMDCODE(",ABMZ("X")="X",ABMZ("MAX")=10

 D HD7 G LOOP7

HD7 W !?5,"REPORT TYPE"

 W ?26,"TRNS TYPE"

 W ?45,"CONTROL NUMBER"

 W !?5,"====================",?26,"==================",?45,"============================"

LOOP7 S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0

 S ABM=0

 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),71,ABM)) Q:'ABM  S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D ATTCH1

 I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")

ATTCH1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),71,ABM("X"),0),ABM("X")=$P(^(0),U)

 S ABMZ(ABM("I"))=$E(("00"_$P(^ABMDCODE(ABM("X"),0),U)),$L($P(^(0),U))+1,4)_U_ABM_U_$P(ABM("X0"),U,2)_U_$P(ABM("X0"),U,3)

 I $Y>(IOSL-5) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT D HD7

 W !,"[",ABM("I"),"]",?5,$P(ABMZ(ABM("I")),U),?8,$E($P(^ABMDCODE(ABM("X"),0),U,3),1,17)

 S ABMTCODE=$P(ABMZ(ABM("I")),U,3)

 W ?26,ABMTCODE_" "

 W $S(ABMTCODE="AA":"Avail On Req",ABMTCODE="BM":"By Mail",ABMTCODE="EL":"Elec Only",ABMTCODE="EM":"E-Mail",ABMTCODE="FX":"By Fax",1:"")

 W ?45,$E($P(ABMZ(ABM("I")),U,4),1,35)

 ;end new code HEAT6439

HD6 ;

 W !?15,"REMARKS"

 W !?6,"========================================"

 I ABMP("EXP")=28 W !,?7,"(19 characters - 1st line; 24 characters x 3 lines max)"

 E  W !,?7,"(48 characters x 4 lines max)"

 W !,?5,"------------------------------------------------"

 N I F I=1:1:4 D

 .W !,"[",I,"]  "

 .W $G(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,I,0))

 W !,?5,"------------------------------------------------",!

 I ABMP("EXP")=12 W !!,"ADA-94 ONLY CONTAINS 62 CHARACTERS.  ADDITIONAL DATA MAY BE CUT OFF"

 I ABMP("EXP")=18 W !!,"ADA-99 ONLY CONTAINS 45 CHARACTERS.  ADDITIONAL DATA MAY BE CUT OFF"

 I ABMP("EXP")=25 W !!,"ADA-2002 ONLY CONTAINS 80 CHARACTERS.  ADDITIONAL DATA MAY BE CUT OFF"

REM1 ;

 Q:$G(ABMQUIET)

 S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=61 D ^DIE

V1 S ABMZ("TITL")="PAGE 9 - VIEW OPTION" D SUM^ABMDE1

 D ^ABMDERR

XIT Q

ABMDE9B   ; IHS/ASDST/DMJ - Page 9 - UB-82 CODES-Cont ;

 +1       ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p10 - IM20337

 +4       ;   Added code for ADA formats

 +5       ;

 +6       ; IHS/SD/SDR - v2.5 p11 - NPI

 +7       ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - added page 9G

 +8       ;

DISP5     ;EP - Entry Point for Spec Prog code

 +1        KILL ABMZ

           SET ABMZ("TITL")="SPECIAL PROGRAM CODES"

           SET ABMZ("PG")="9E"

 +2        IF $DATA(ABMP("DDL"))

               IF $Y>(IOSL-9)

                   DO PAUSE^ABMDE1

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

                       GOTO XIT

                   IF 1

 +3       IF '$TEST

               DO SUM^ABMDE1

 +4       ;

SPCL      ; Special Program

 +1        SET ABMZ("SUB")=59

           SET ABMZ("DR")=""

           SET ABMZ("ITEM")="Special Program Code"

           SET ABMZ("DIC")="^ABMDCODE("

           SET ABMZ("X")="DINUM"

           SET ABMZ("MAX")=1

 +2        DO HD5

           GOTO LOOP5

HD5        WRITE !?6,"PRGM"

 +1        WRITE !?6,"CODE",?14,"           SPECIAL PROGRAM DESCRIPTION"

 +2        WRITE !?6,"====",?14,"============================================================"

 +3        QUIT

LOOP5      SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0

           SET ABM=0

           FOR ABM("I")=1:1

               SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM))

               IF 'ABM

                   QUIT

               SET ABM("X")=ABM

               SET ABMZ("NUM")=ABM("I")

               DO SPCL1

 +1        IF +$ORDER(ABME(0))

               SET ABME("CONT")=""

               DO ^ABMDERR

               KILL ABME("CONT")

 +2        QUIT

SPCL1      SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),0)

           SET ABM("X")=$PIECE(^(0),U)

 +1        SET ABMZ(ABM("I"))=$EXTRACT(("00"_$PIECE(^ABMDCODE(ABM("X"),0),U)),$LENGTH($PIECE(^(0),U))+1,4)_U_ABM_U_$PIECE(ABM("X0"),U,2)

 +2        IF $Y>(IOSL-5)

               DO PAUSE^ABMDE1

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

                   GOTO XIT

               DO HD5

 +3        WRITE !,"[",ABM("I"),"]",?7,$PIECE(ABMZ(ABM("I")),U),?14,$PIECE(^ABMDCODE(ABM("X"),0),U,3)

 +4        QUIT

 +5       ;

DISP6     ;EP - Entry Point for Remarks

 +1        NEW I

           FOR I=1:1:4

               Begin DoDot:1

 +2                IF '$DATA(^ABMDEXP(ABMP("EXP"),2,I,0))

                       QUIT

 +3                IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,I,0))

                       QUIT

 +4                SET ^ABMDCLM(DUZ(2),ABMP("CDFN"),61,I,0)=^ABMDEXP(ABMP("EXP"),2,I,0)

 +5                SET ^ABMDCLM(DUZ(2),ABMP("CDFN"),61,0)="^^"_I_"^"_I_"^"_DT

               End DoDot:1

 +6        KILL ABMZ

           SET ABMZ("TITL")="REMARKS"

           SET ABMZ("PG")="9F"

 +7        IF $DATA(ABMP("DDL"))

               IF $Y>(IOSL-9)

                   DO PAUSE^ABMDE1

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

                       GOTO XIT

                   IF 1

 +8       IF '$TEST

               DO SUM^ABMDE1

 +9       ;

REM       ; Remarks

 +1        DO HD6

           DO REM1

 +2        QUIT

 +3       ;start new code abm*2.6*1 HEAT6439

DISP7     ;EP - Entry Point for Claim Attachments

 +1        KILL ABMZ

           SET ABMZ("TITL")="CLAIM ATTACHMENTS"

           SET ABMZ("PG")="9G"

 +2        IF $DATA(ABMP("DDL"))

               IF $Y>(IOSL-9)

                   DO PAUSE^ABMDE1

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

                       GOTO XIT

                   IF 1

 +3       IF '$TEST

               DO SUM^ABMDE1

 +4       ;

CATTCH    ; Claim Attachments

 +1        SET ABMZ("SUB")=71

           SET ABMZ("DR")=";W !;.02Transmission Code//;.03Control Number//"

           SET ABMZ("ITEM")="Claim Attachment"

           SET ABMZ("DIC")="^ABMDCODE("

           SET ABMZ("X")="X"

           SET ABMZ("MAX")=10

 +2        DO HD7

           GOTO LOOP7

HD7        WRITE !?5,"REPORT TYPE"

 +1        WRITE ?26,"TRNS TYPE"

 +2        WRITE ?45,"CONTROL NUMBER"

 +3        WRITE !?5,"====================",?26,"==================",?45,"============================"

 +4        QUIT

LOOP7      SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1))=0

 +1        SET ABM=0

 +2        FOR ABM("I")=1:1

               SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),71,ABM))

               IF 'ABM

                   QUIT

               SET ABM("X")=ABM

               SET ABMZ("NUM")=ABM("I")

               DO ATTCH1

 +3        IF +$ORDER(ABME(0))

               SET ABME("CONT")=""

               DO ^ABMDERR

               KILL ABME("CONT")

 +4        QUIT

ATTCH1     SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),71,ABM("X"),0)

           SET ABM("X")=$PIECE(^(0),U)

 +1        SET ABMZ(ABM("I"))=$EXTRACT(("00"_$PIECE(^ABMDCODE(ABM("X"),0),U)),$LENGTH($PIECE(^(0),U))+1,4)_U_ABM_U_$PIECE(ABM("X0"),U,2)_U_$PIECE(ABM("X0"),U,3)

 +2        IF $Y>(IOSL-5)

               DO PAUSE^ABMDE1

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

                   GOTO XIT

               DO HD7

 +3        WRITE !,"[",ABM("I"),"]",?5,$PIECE(ABMZ(ABM("I")),U),?8,$EXTRACT($PIECE(^ABMDCODE(ABM("X"),0),U,3),1,17)

 +4        SET ABMTCODE=$PIECE(ABMZ(ABM("I")),U,3)

 +5        WRITE ?26,ABMTCODE_" "

 +6        WRITE $SELECT(ABMTCODE="AA":"Avail On Req",ABMTCODE="BM":"By Mail",ABMTCODE="EL":"Elec Only",ABMTCODE="EM":"E-Mail",ABMTCODE="FX":"By Fax",1:"")

 +7        WRITE ?45,$EXTRACT($PIECE(ABMZ(ABM("I")),U,4),1,35)

 +8        QUIT

 +9       ;end new code HEAT6439

HD6       ;

 +1        WRITE !?15,"REMARKS"

 +2        WRITE !?6,"========================================"

 +3        IF ABMP("EXP")=28

               WRITE !,?7,"(19 characters - 1st line; 24 characters x 3 lines max)"

 +4       IF '$TEST

               WRITE !,?7,"(48 characters x 4 lines max)"

 +5        WRITE !,?5,"------------------------------------------------"

 +6        NEW I

           FOR I=1:1:4

               Begin DoDot:1

 +7                WRITE !,"[",I,"]  "

 +8                WRITE $GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),61,I,0))

               End DoDot:1

 +9        WRITE !,?5,"------------------------------------------------",!

 +10       IF ABMP("EXP")=12

               WRITE !!,"ADA-94 ONLY CONTAINS 62 CHARACTERS.  ADDITIONAL DATA MAY BE CUT OFF"

 +11       IF ABMP("EXP")=18

               WRITE !!,"ADA-99 ONLY CONTAINS 45 CHARACTERS.  ADDITIONAL DATA MAY BE CUT OFF"

 +12       IF ABMP("EXP")=25

               WRITE !!,"ADA-2002 ONLY CONTAINS 80 CHARACTERS.  ADDITIONAL DATA MAY BE CUT OFF"

 +13       QUIT

REM1      ;

 +1        IF $GET(ABMQUIET)

               QUIT

 +2        SET DIE="^ABMDCLM(DUZ(2),"

           SET DA=ABMP("CDFN")

           SET DR=61

           DO ^DIE

 +3        QUIT

 +4       ;

V1         SET ABMZ("TITL")="PAGE 9 - VIEW OPTION"

           DO SUM^ABMDE1

 +1        DO ^ABMDERR

 +2        QUIT

 +3       ;

XIT        QUIT

ABMDE9B.m