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,"============================================================"
Q
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")
Q
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)
Q
;
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
Q
;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,"============================"
Q
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")
Q
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)
Q
;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"
Q
REM1 ;
Q:$G(ABMQUIET)
S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN"),DR=61 D ^DIE
Q
;
V1 S ABMZ("TITL")="PAGE 9 - VIEW OPTION" D SUM^ABMDE1
D ^ABMDERR
Q
;
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
