ABMDF34X ; IHS/SD/SDR - ADA-2012 FORM ;
;;2.6;IHS 3P BILLING SYSTEM;**11,13,21,22**;NOV 12, 2009;Build 418
;IHS/SD/SDR - 2.6*13 - VMBP - RQMT_95 - Added code to populated remarks box 35 (line 41)
;IHS/SD/SDR - 2.6*21 - HEAT166874 - fix for programming error so test claim will print correctly
;IHS/SD/SDR - 2.6*21 - HEAT205579 - Made T1015 print first for ARBOR HEALTH PLAN
;IHS/SD/SDR - 2.6*21 - HEAT284071 - Added check for FL override for ADA-2012
;IHS/SD/SDR 2.6*22 HEAT313777 Added check for new parameter that will allow/not allow decimal to print in dollar amounts
;************************************************************************************
;
MARG ;Set left and top margins
S U="^",(ABM("LM"),ABM("TM"),ABM("LN"))=0
I $D(^ABMDEXP(34,0)) S ABM("TM")=$P(^(0),U,3),ABM("LM")=$P(^(0),U,2)
W $$EN^ABMVDF("IOF")
I +ABM("TM") F ABM("I")=1:1:ABM("TM") W !
D:$G(ABMP("INS")) OVER ;abm*2.6*21 IHS/SD/SDR HEAT284071
;
LOOP ;
;Loop thru line number array
S ABM("LN")=$O(ABMF(ABM("LN"))) I +ABM("LN")=0!(ABM("LN")>63) G XIT
;
;Set to correct format line
S ABM("FL")=ABM("LN")
I ABM("LN")>25,ABM("LN")<36 S ABM("FL")=26 ;Lines 27 thru 36 are same
I ABM("LN")>38,ABM("LN")<42 S ABM("FL")=39 ;Lines 39 thru 42 are same
;
;Set tab & format variables
S ABM("TABS")=$P($T(@ABM("FL")),";;",2)
S ABM("FMAT")=$P($T(@ABM("FL")),";;",3)
;
;added NE Medicaid code for W0047 to print first
;I ABMP("ITYP")="D" D ;abm*2.6*21 IHS/SD/SDR HEAT166874
I ($G(ABMP("ITYP"))="D")!((+$G(ABMP("INS"))'=0)&(($P($G(^AUTNINS(+$G(ABMP("INS")),0)),U)="ARBOR HEALTH PLAN"))) D ;abm*2.6*21 IHS/SD/SDR HEAT166874 and HEAT205579
.F ABMLOOP=26:1:36 D
..Q:'$D(ABMF(ABMLOOP))
..S ABMCHK=$P(ABMF(ABMLOOP),U,6)
..I ABMCHK["T1015",ABMLOOP'=26 D
...S ABMF("TMP")=$G(ABMF(26))
...S ABMF(26)=$G(ABMF(ABMLOOP))
...S ABMF(ABMLOOP)=$G(ABMF("TMP"))
K ABMLOOP,ABMCHK,ABMF("TMP")
;
;Skip to req'd line
F Q:$Y-ABM("TM")>(ABM("LN")+0) W !
;
; Test Modes for setting Data Fields
G LOOP2:'$D(ABMF("TEST"))
F ABM("I")=1:1:$L(ABM("FMAT"),U) D
.I $P(ABM("TABS"),U,ABM("I"))]"" D
..S ABM("FLD")=""
..S $P(ABM("FLD"),"X",$P(ABM("FMAT"),U,ABM("I"))+1)=""
..I ABM("FLD")]"" D
...W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM"))
...D FRMT
G LOOP
;
LOOP2 ;
;Loop thru the pieces of the line array
F ABM("I")=1:1:$L(ABMF(ABM("LN")),U) D
.I $P(ABM("TABS"),U,ABM("I"))]"" D
..S ABM("FLD")=$P(ABMF(ABM("LN")),U,ABM("I"))
..I ABM("FLD")]"" D
...W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM"))
...D FRMT
G LOOP
;
FRMT ;
;Write the field in the designated format
S ABM("LTH")=$P(ABM("FMAT"),U,ABM("I"))
I +ABM("LTH")=0 S ABM("LTH")=99
;
I ABM("LTH")["$" D Q
.S ABM("LTH")=$P(ABM("LTH"),"$")
.;S ABM("FLD")=$TR($FN(+ABM("FLD"),"",2),".") ;abm*2.6*22 IHS/SD/SDR HEAT313777
.S ABM("FLD")=$FN(+ABM("FLD"),"",2) ;abm*2.6*22 IHS/SD/SDR HEAT313777
.S ABM("FLD")=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,22)="Y":ABM("FLD"),1:$TR(ABM("FLD"),".")) ;abm*2.6*22 IHS/SD/SDR HEAT313777
.S ABM("RT")=ABM("LTH")-$L(ABM("FLD"))+1
.I ABM("RT")>1 D
..S ABM("BLNK")=""
..S $P(ABM("BLNK")," ",ABM("RT"))=""
..S ABM("FLD")=ABM("BLNK")_ABM("FLD")
.W $E(ABM("FLD"),1,ABM("LTH"))
;
I ABM("LTH")["D" D Q
.S ABM("LTH")=$P(ABM("LTH"),"D")
.W $E(ABM("FLD"),4,5),"/",$E(ABM("FLD"),6,7),"/",($E(ABM("FLD"),1,3)+1700)
;
I ABM("LTH")["L" D
.S ABM("LTH")=$P(ABM("LTH"),"L")
.F Q:$L(ABM("FLD"))=ABM("LTH")!($L(ABM("FLD"))>ABM("LTH")) D
..S ABM("FLD")="0"_ABM("FLD")
;
I ABM("LTH")["C" D
.S ABM("LTH")=$P(ABM("LTH"),"C")
.S ABM("FLD")=$J("",ABM("LTH")-$L(ABM("FLD"))\2)_ABM("FLD")
;
I ABM("LTH")["R" D
.S ABM("LTH")=$P(ABM("LTH"),"R")
.S ABM("RT")=ABM("LTH")-$L(ABM("FLD"))+1
.I ABM("RT")>1 D
..S ABM("BLNK")=""
..S $P(ABM("BLNK")," ",ABM("RT"))=""
..S ABM("FLD")=ABM("BLNK")_ABM("FLD")
;
W $E(ABM("FLD"),1,ABM("LTH"))
Q
;
TEST ;
S ABMF("TEST")=1
F ABM=0:ABMF("TEST"):63 S ABMF(ABM)=""
G MARG
;start new abm*2.6*21 IHS/SD/SDR HEAT284071
OVER ;GET OVRRIDE VALUES FROM 3P INSURER FILE
S ABMOLN=0
F S ABMOLN=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN)) Q:'ABMOLN D
.S ABMOPC=0
.F S ABMOPC=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC)) Q:'ABMOPC D
..K ABMOVTYP
..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC,0)) S ABMOVTYP=0
..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")
..Q:'$D(ABMOVTYP)
..S ABMVALUE=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC,ABMOVTYP)
..S $P(ABMF(ABMOLN),"^",ABMOPC)=ABMVALUE
K ABMOLN,ABMOPC,ABMVALUE,ABMOVTYP
Q
;end new abm*2.6*21 IHS/SD/SDR HEAT284071
;
XIT ;
I '$D(ABM("MORE")) K ABMF,ABM
E K ABM("MORE")
Q
TEXT ;;TABS;;FIELD LENGTH
; FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)
1 ;;1;;1
2 ;;1;;1
4 ;;1;;30
5 ;;42;;30
6 ;;42;;30
7 ;;5^42;;34^30
8 ;;5;;34
9 ;;5;;34
10 ;;42^56^59^64;;10D^1^1^15
12 ;;6^13^42^55;;1^1^12^20
14 ;;1;;30
15 ;;42^47^53^62^70^75;;1^1^1^1^1^1
16 ;;1^15^18^23;;10D^1^1^10
17 ;;42;;30
18 ;;1^15^20^26^33^42;;11^1^1^1^1^30
19 ;;42;;30
20 ;;1;;30
21 ;;1;;30
22 ;;1^42^56^59^63;;30^10D^1^1^16
26 ;;1^12^15^18^30^36^42^47^50^74;;10D^2^2^11^5^5^5^2^23^6$
36 ;;47^74;;2^6$
37 ;;48^59;;8^8
38 ;;48^59^74;;8^8^6$
39 ;;5;;73
41 ;;1;;40
;abm*2.6*13 VMBP RQMT_95
42 ;;49;;2
43 ;;70;;1
45 ;;1^28^42^51^65;;25^10D^1^1^10D
47 ;;47^51^54^65;;2^1^1^10D
49 ;;2^29^43^58^68;;25^10D^1^1^1
50 ;;56^77;;10D^2
54 ;;2^42^69;;30^25^10D
55 ;;2;;30
56 ;;2^48^69;;30^10^10
57 ;;68;;10
58 ;;43;;30
59 ;;1^14^27^43;;10^10^11^30
60 ;;6^28^46^68;;14^14^14^10
ABMDF34X ; IHS/SD/SDR - ADA-2012 FORM ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,13,21,22**;NOV 12, 2009;Build 418
+2 ;IHS/SD/SDR - 2.6*13 - VMBP - RQMT_95 - Added code to populated remarks box 35 (line 41)
+3 ;IHS/SD/SDR - 2.6*21 - HEAT166874 - fix for programming error so test claim will print correctly
+4 ;IHS/SD/SDR - 2.6*21 - HEAT205579 - Made T1015 print first for ARBOR HEALTH PLAN
+5 ;IHS/SD/SDR - 2.6*21 - HEAT284071 - Added check for FL override for ADA-2012
+6 ;IHS/SD/SDR 2.6*22 HEAT313777 Added check for new parameter that will allow/not allow decimal to print in dollar amounts
+7 ;************************************************************************************
+8 ;
MARG ;Set left and top margins
+1 SET U="^"
SET (ABM("LM"),ABM("TM"),ABM("LN"))=0
+2 IF $DATA(^ABMDEXP(34,0))
SET ABM("TM")=$PIECE(^(0),U,3)
SET ABM("LM")=$PIECE(^(0),U,2)
+3 WRITE $$EN^ABMVDF("IOF")
+4 IF +ABM("TM")
FOR ABM("I")=1:1:ABM("TM")
WRITE !
+5 ;abm*2.6*21 IHS/SD/SDR HEAT284071
IF $GET(ABMP("INS"))
DO OVER
+6 ;
LOOP ;
+1 ;Loop thru line number array
+2 SET ABM("LN")=$ORDER(ABMF(ABM("LN")))
IF +ABM("LN")=0!(ABM("LN")>63)
GOTO XIT
+3 ;
+4 ;Set to correct format line
+5 SET ABM("FL")=ABM("LN")
+6 ;Lines 27 thru 36 are same
IF ABM("LN")>25
IF ABM("LN")<36
SET ABM("FL")=26
+7 ;Lines 39 thru 42 are same
IF ABM("LN")>38
IF ABM("LN")<42
SET ABM("FL")=39
+8 ;
+9 ;Set tab & format variables
+10 SET ABM("TABS")=$PIECE($TEXT(@ABM("FL")),";;",2)
+11 SET ABM("FMAT")=$PIECE($TEXT(@ABM("FL")),";;",3)
+12 ;
+13 ;added NE Medicaid code for W0047 to print first
+14 ;I ABMP("ITYP")="D" D ;abm*2.6*21 IHS/SD/SDR HEAT166874
+15 ;abm*2.6*21 IHS/SD/SDR HEAT166874 and HEAT205579
IF ($GET(ABMP("ITYP"))="D")!((+$GET(ABMP("INS"))'=0)&(($PIECE($GET(^AUTNINS(+$GET(ABMP("INS")),0)),U)="ARBOR HEALTH PLAN")))
Begin DoDot:1
+16 FOR ABMLOOP=26:1:36
Begin DoDot:2
+17 IF '$DATA(ABMF(ABMLOOP))
QUIT
+18 SET ABMCHK=$PIECE(ABMF(ABMLOOP),U,6)
+19 IF ABMCHK["T1015"
IF ABMLOOP'=26
Begin DoDot:3
+20 SET ABMF("TMP")=$GET(ABMF(26))
+21 SET ABMF(26)=$GET(ABMF(ABMLOOP))
+22 SET ABMF(ABMLOOP)=$GET(ABMF("TMP"))
End DoDot:3
End DoDot:2
End DoDot:1
+23 KILL ABMLOOP,ABMCHK,ABMF("TMP")
+24 ;
+25 ;Skip to req'd line
+26 FOR
IF $Y-ABM("TM")>(ABM("LN")+0)
QUIT
WRITE !
+27 ;
+28 ; Test Modes for setting Data Fields
+29 IF '$DATA(ABMF("TEST"))
GOTO LOOP2
+30 FOR ABM("I")=1:1:$LENGTH(ABM("FMAT"),U)
Begin DoDot:1
+31 IF $PIECE(ABM("TABS"),U,ABM("I"))]""
Begin DoDot:2
+32 SET ABM("FLD")=""
+33 SET $PIECE(ABM("FLD"),"X",$PIECE(ABM("FMAT"),U,ABM("I"))+1)=""
+34 IF ABM("FLD")]""
Begin DoDot:3
+35 WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))
+36 DO FRMT
End DoDot:3
End DoDot:2
End DoDot:1
+37 GOTO LOOP
+38 ;
LOOP2 ;
+1 ;Loop thru the pieces of the line array
+2 FOR ABM("I")=1:1:$LENGTH(ABMF(ABM("LN")),U)
Begin DoDot:1
+3 IF $PIECE(ABM("TABS"),U,ABM("I"))]""
Begin DoDot:2
+4 SET ABM("FLD")=$PIECE(ABMF(ABM("LN")),U,ABM("I"))
+5 IF ABM("FLD")]""
Begin DoDot:3
+6 WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))
+7 DO FRMT
End DoDot:3
End DoDot:2
End DoDot:1
+8 GOTO LOOP
+9 ;
FRMT ;
+1 ;Write the field in the designated format
+2 SET ABM("LTH")=$PIECE(ABM("FMAT"),U,ABM("I"))
+3 IF +ABM("LTH")=0
SET ABM("LTH")=99
+4 ;
+5 IF ABM("LTH")["$"
Begin DoDot:1
+6 SET ABM("LTH")=$PIECE(ABM("LTH"),"$")
+7 ;S ABM("FLD")=$TR($FN(+ABM("FLD"),"",2),".") ;abm*2.6*22 IHS/SD/SDR HEAT313777
+8 ;abm*2.6*22 IHS/SD/SDR HEAT313777
SET ABM("FLD")=$FNUMBER(+ABM("FLD"),"",2)
+9 ;abm*2.6*22 IHS/SD/SDR HEAT313777
SET ABM("FLD")=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,22)="Y":ABM("FLD"),1:$TRANSLATE(ABM("FLD"),"."))
+10 SET ABM("RT")=ABM("LTH")-$LENGTH(ABM("FLD"))+1
+11 IF ABM("RT")>1
Begin DoDot:2
+12 SET ABM("BLNK")=""
+13 SET $PIECE(ABM("BLNK")," ",ABM("RT"))=""
+14 SET ABM("FLD")=ABM("BLNK")_ABM("FLD")
End DoDot:2
+15 WRITE $EXTRACT(ABM("FLD"),1,ABM("LTH"))
End DoDot:1
QUIT
+16 ;
+17 IF ABM("LTH")["D"
Begin DoDot:1
+18 SET ABM("LTH")=$PIECE(ABM("LTH"),"D")
+19 WRITE $EXTRACT(ABM("FLD"),4,5),"/",$EXTRACT(ABM("FLD"),6,7),"/",($EXTRACT(ABM("FLD"),1,3)+1700)
End DoDot:1
QUIT
+20 ;
+21 IF ABM("LTH")["L"
Begin DoDot:1
+22 SET ABM("LTH")=$PIECE(ABM("LTH"),"L")
+23 FOR
IF $LENGTH(ABM("FLD"))=ABM("LTH")!($LENGTH(ABM("FLD"))>ABM("LTH"))
QUIT
Begin DoDot:2
+24 SET ABM("FLD")="0"_ABM("FLD")
End DoDot:2
End DoDot:1
+25 ;
+26 IF ABM("LTH")["C"
Begin DoDot:1
+27 SET ABM("LTH")=$PIECE(ABM("LTH"),"C")
+28 SET ABM("FLD")=$JUSTIFY("",ABM("LTH")-$LENGTH(ABM("FLD"))\2)_ABM("FLD")
End DoDot:1
+29 ;
+30 IF ABM("LTH")["R"
Begin DoDot:1
+31 SET ABM("LTH")=$PIECE(ABM("LTH"),"R")
+32 SET ABM("RT")=ABM("LTH")-$LENGTH(ABM("FLD"))+1
+33 IF ABM("RT")>1
Begin DoDot:2
+34 SET ABM("BLNK")=""
+35 SET $PIECE(ABM("BLNK")," ",ABM("RT"))=""
+36 SET ABM("FLD")=ABM("BLNK")_ABM("FLD")
End DoDot:2
End DoDot:1
+37 ;
+38 WRITE $EXTRACT(ABM("FLD"),1,ABM("LTH"))
+39 QUIT
+40 ;
TEST ;
+1 SET ABMF("TEST")=1
+2 FOR ABM=0:ABMF("TEST"):63
SET ABMF(ABM)=""
+3 GOTO MARG
+4 ;start new abm*2.6*21 IHS/SD/SDR HEAT284071
OVER ;GET OVRRIDE VALUES FROM 3P INSURER FILE
+1 SET ABMOLN=0
+2 FOR
SET ABMOLN=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN))
IF 'ABMOLN
QUIT
Begin DoDot:1
+3 SET ABMOPC=0
+4 FOR
SET ABMOPC=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC))
IF 'ABMOPC
QUIT
Begin DoDot:2
+5 KILL ABMOVTYP
+6 IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC,0))
SET ABMOVTYP=0
+7 IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC,ABMP("VTYP")))
SET ABMOVTYP=ABMP("VTYP")
+8 IF '$DATA(ABMOVTYP)
QUIT
+9 SET ABMVALUE=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",34,ABMOLN,ABMOPC,ABMOVTYP)
+10 SET $PIECE(ABMF(ABMOLN),"^",ABMOPC)=ABMVALUE
End DoDot:2
End DoDot:1
+11 KILL ABMOLN,ABMOPC,ABMVALUE,ABMOVTYP
+12 QUIT
+13 ;end new abm*2.6*21 IHS/SD/SDR HEAT284071
+14 ;
XIT ;
+1 IF '$DATA(ABM("MORE"))
KILL ABMF,ABM
+2 IF '$TEST
KILL ABM("MORE")
+3 QUIT
TEXT ;;TABS;;FIELD LENGTH
+1 ; FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)
1 ;;1;;1
2 ;;1;;1
4 ;;1;;30
5 ;;42;;30
6 ;;42;;30
7 ;;5^42;;34^30
8 ;;5;;34
9 ;;5;;34
10 ;;42^56^59^64;;10D^1^1^15
12 ;;6^13^42^55;;1^1^12^20
14 ;;1;;30
15 ;;42^47^53^62^70^75;;1^1^1^1^1^1
16 ;;1^15^18^23;;10D^1^1^10
17 ;;42;;30
18 ;;1^15^20^26^33^42;;11^1^1^1^1^30
19 ;;42;;30
20 ;;1;;30
21 ;;1;;30
22 ;;1^42^56^59^63;;30^10D^1^1^16
26 ;;1^12^15^18^30^36^42^47^50^74;;10D^2^2^11^5^5^5^2^23^6$
36 ;;47^74;;2^6$
37 ;;48^59;;8^8
38 ;;48^59^74;;8^8^6$
39 ;;5;;73
41 ;;1;;40
+1 ;abm*2.6*13 VMBP RQMT_95
42 ;;49;;2
43 ;;70;;1
45 ;;1^28^42^51^65;;25^10D^1^1^10D
47 ;;47^51^54^65;;2^1^1^10D
49 ;;2^29^43^58^68;;25^10D^1^1^1
50 ;;56^77;;10D^2
54 ;;2^42^69;;30^25^10D
55 ;;2;;30
56 ;;2^48^69;;30^10^10
57 ;;68;;10
58 ;;43;;30
59 ;;1^14^27^43;;10^10^11^30
60 ;;6^28^46^68;;14^14^14^10
