ABMDF34X.m

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