ABMDF14X.m

ABMDF14X ; IHS/ASDST/DMJ - New HCFA-1500 Format ;   

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;

 ;

 ;IHS/DSD/DMJ - 3/8/1999 - Patch 1 NOIS HQW-0399-100108

 ;            Modified line 31 to change 2 units to 1

 ;IHS/ASDS/LSLS - 06/04/01 - V2.4 Patch 5 - NOIS OWF-0601-190005

 ;    Modified line 37 to allow 10 digits in 24k instead of 9

 ;

 ;IHS/SD/SDR - 11/6/2003 - v2.5 p4 - IM11164

 ;    Modified line 37 to tab to 70 instead of 71 so all 10 digits

 ;    will print.

 ;

 ; IHS/SD/SDR - v2.5 p9 - IM16769

 ;    Added changes for Maine Medicaid

 ;

 ; IHS/SD/SDR - v2.5 p9 - IM16876

 ;    (cont) removed from block 28/30 if payment

 ;

 ; IHS/SD/SDR - v2.5 p10 - IM20006/IM20245

 ;   Alignment of FL5(phone#), FL24D, and FL24G

 ;

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

 ;    Extended block 33 group number to hold 13 characters

 ;

 ; Import Array: ABMF(line #) = piece 1 ^ piece 2 ^....

 ;         where: line # is the printable horizontal row

 ;                piece is the data element to be printed

 ;

 ; Objective: Print designated form using data contained in the

 ;            ABMF array.

 ;

MARG ;Set left and top margins

 S (ABM("LM"),ABM("TM"),ABM("LN"))=0

 I $G(IOT)'="HFS" S ABM("TM")=$P(^ABMDEXP(14,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

 ;

LOOP ;Loop thru line number array

 S ABM("LN")=$O(ABMF(ABM("LN"))) I +ABM("LN")=0!(ABM("LN")>56) G XIT

 ;

 ;Check for invalid line numbers

 F ABM("I")=2,4,6,8,10,12,14,16,18,20,21,22,24,26,28,30,32,34,35,48,55,56,57 I ABM("LN")=ABM("I") Q

 I  G LOOP

 ;

 ;Set to correct format line

 S ABM("FL")=ABM("LN")

 I ABM("LN")>35,(ABM("LN")<48),$L(ABMF(ABM("LN")),"^")<3 S ABM("FL")=36

 I ABM("LN")>35,(ABM("LN")<48),$L(ABMF(ABM("LN")),"^")>3 S ABM("FL")=37

 ;

 ;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 $P(ABMF(17),U,4)["NEBRASKA MEDICAID",ABMP("VTYP")=131 D

 .F ABMLOOP=37:2:47 D

 ..Q:'$D(ABMF(ABMLOOP))

 ..S ABMCHK=$TR($P(ABMF(ABMLOOP),U,5)," ","")

 ..I ABMCHK["W0047",ABMLOOP'=37 D

 ...S ABMF("TMP")=$G(ABMF(37))

 ...S ABMF(37)=$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")+5)  W ! D

 .Q:($Y-ABM("TM")<1)!($Y-ABM("TM")>5)

 .Q:$D(ABMF("TEST"))

 .I $Y-ABM("TM")=5 W ?1,"XXX",?76,"XXX" Q

 .Q:'$D(ABMP("INS"))  K ABM("INS")

 .I ($Y-ABM("TM"))=1 D

 ..S ABM("J")=ABMP("BDFN"),ABM("I")=$P(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")

 ..S ABM("INS",ABM("I"),ABM("J"))=$S(ABM("I")["NON-BENEFICIARY PATIENT":$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",5),1:"")

 ..D BADDR^ABMDLBL1

 ..W ?33,"To:"

 .Q:'$D(ABM("ADD"))

 .W ?37,$P(ABM("ADD"),U,($Y-ABM("TM")))

 ;

 ; Test Modes for setting Data Fields

 G LOOP2:'$D(ABMF("TEST"))

 F ABM("I")=1:1:$L(ABM("FMAT"),U) I $P(ABM("TABS"),U,ABM("I"))]"" S ABM("FLD")="",$P(ABM("FLD"),"X",$P(ABM("FMAT"),U,ABM("I"))+1)="" I ABM("FLD")]"" 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

 .Q:'+$P(ABM("TABS"),U,ABM("I"))

 .I ABM("LN")>30,(ABM("LN")<34),(ABM("I")<3),($P(ABMF(17),U,4)["MAINE MEDICAID") D

 ..S $P(ABMF(ABM("LN")),U,ABM("I"))=$TR($P(ABMF(ABM("LN")),U,ABM("I")),".","")

 .;if Maine Medicaid take commas of out box 24E

 .I ABM("LN")>36,(ABM("LN")<48),(ABM("I")=6),($P(ABMF(17),U,4)["MAINE MEDICAID") D

 ..S $P(ABMF(ABM("LN")),U,ABM("I"))=$TR($P(ABMF(ABM("LN")),U,ABM("I")),",","")

 .S ABM("FLD")=$P(ABMF(ABM("LN")),U,ABM("I"))

 .I $G(ABMP("PTOT"))'=1,($D(ABMP("MORE"))),(ABM("LN")=49),(ABM("I")=7!(ABM("I")=9)) S ABM("FLD")=$G(ABM("LTOT"))

 .I ABM("FLD")]"" W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM")) D FRMT

 .;Put "cont" in total charges box if multi page.

 .I $D(ABMR("MORE")),ABM("LN")=49,ABM("I")=7,$G(ABMP("PTOT"))=1 W ?52,"(CONT.)"

 G LOOP

 ;

 ;Write the field in the designated format

FRMT S ABM("LTH")=$P(ABM("FMAT"),U,ABM("I")) I +ABM("LTH")=0 S ABM("LTH")=99

 I ABM("LTH")["$" S ABM("LTH")=$P(ABM("LTH"),"$") W $J($FN(+ABM("FLD"),",",2),ABM("LTH")) S:ABM("LN")'=49 ABM("LTOT")=+$G(ABM("LTOT"))+ABM("FLD") Q

 ;if Maine Medicaid take spaces out of dates

 I $P(ABMF(17),U,4)["MAINE MEDICAID",(ABM("LTH")["D") S ABM("LTH")=$P(ABM("LTH"),"D") W $E(ABM("FLD"),4,5),$E(ABM("FLD"),6,7),$E(ABM("FLD"),1,3)+1700 Q

 I ABM("LTH")["D" S ABM("LTH")=$P(ABM("LTH"),"D") W $E(ABM("FLD"),4,5)," ",$E(ABM("FLD"),6,7)," ",$E(ABM("FLD"),1,3)+1700 Q

 I ABM("LTH")["Y" S ABM("LTH")=$P(ABM("LTH"),"Y") W $E(ABM("FLD"),4,7),$E(ABM("FLD"),1,3)+1700 Q

 I ABM("LTH")["L" S ABM("LTH")=$P(ABM("LTH"),"L") F  Q:$L(ABM("FLD"))=ABM("LTH")!($L(ABM("FLD"))>ABM("LTH"))  S ABM("FLD")="0"_ABM("FLD")

 I ABM("LTH")["C" S ABM("LTH")=$P(ABM("LTH"),"C") S ABM("FLD")=$J("",ABM("LTH")-$L(ABM("FLD"))\2)_ABM("FLD")

 I ABM("LTH")["R" S ABM("LTH")=$P(ABM("LTH"),"R") S ABM("RT")=ABM("LTH")-$L(ABM("FLD"))+1 I ABM("RT")>1 S ABM("BLNK")="",$P(ABM("BLNK")," ",ABM("RT"))="",ABM("FLD")=ABM("BLNK")_ABM("FLD")

 W $E(ABM("FLD"),1,ABM("LTH"))

 Q

 ;

TEST S ABMF("TEST")=1

 F ABM=0:ABMF("TEST"):60 S ABMF(ABM)=""

 G MARG

 ;

OVER ;GET OVRRIDE VALUES FROM 3P INSURER FILE

 S ABMOLN=0 F  S ABMOLN=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN)) Q:'ABMOLN  D

 .S ABMOPC=0 F  S ABMOPC=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC)) Q:'ABMOPC  D

 ..K ABMOVTYP

 ..I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC,0)) S ABMOVTYP=0

 ..I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")

 ..Q:'$D(ABMOVTYP)

 ..S ABMVALUE=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC,ABMOVTYP)

 ..I ABMOLN>36,ABMOLN<49 N I F I=37:2:47 D

 ...Q:'$D(ABMF(I))

 ...Q:$L(ABMF(I),"^")<3

 ...S $P(ABMF(I),"^",ABMOPC)=ABMVALUE

 ..I ABMOLN>36,ABMOLN<49 Q

 ..S $P(ABMF(ABMOLN),"^",ABMOPC)=ABMVALUE

 K ABMOLN,ABMOPC,ABMVALUE,ABMOVTYP

 Q

XIT K ABM

 I '$D(ABMR("MORE")) K ABMF

 Q

TEXT ;;TABS;;FIELD LENGTH

 ;            FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)

1 ;;1^8^15^24^31^39^45^50;;1^1^1^1^1^1^1^29C

3 ;;1^31^42^47^50;;28^10D^1^1^29C

5 ;;1^33^38^42^47^50;;28^1^1^1^1^29C

7 ;;1^27^35^41^47^50^75;;24^2^1^1^1^23C^2

9 ;;1^14^35^41^47^50^64;;12^14^1^1^1^12C^14

11 ;;1^50;;28^29C

13 ;;1^35^41^54^68^75;;28^1^1^10D^1^1

15 ;;2^18^24^35^41^46^50;;10D^1^1^1^1^2^29C

17 ;;1^35^41^50;;28C^1^1^29C

19 ;;1^30^52^57;;28C^19C^1^1

23 ;;6^37^56;;24C^10D^23

25 ;;2^37^54^68;;10D^10D^10D^10D

27 ;;1^28^54^68;;26^21C^10D^10D

29 ;;1^52^57^62;;48^1^1^8$

31 ;;3^30^50;;25^19^29

33 ;;3^30^50;;25^19^29C

36 ;;25^71;;16^9

37 ;;1^10^19^22^25^42^50^59^62^65^68^70;;8Y^8Y^2R^2R^16^7C^8$^3R^2R^2R^2R^10

49 ;;1^17^19^23^38^43^50^61^71;;15^1^1^14C^1^1^10$^9$^8$

50 ;;65;;14

51 ;;23^50;;26^29

52 ;;1^23^50;;21^26^29

53 ;;1^23^50;;21^26^29

54 ;;12^23^49^67;;10D^26^13R^13C

ABMDF14X  ; IHS/ASDST/DMJ - New HCFA-1500 Format ;   

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;Original;TMD;

 +3       ;

 +4       ;IHS/DSD/DMJ - 3/8/1999 - Patch 1 NOIS HQW-0399-100108

 +5       ;            Modified line 31 to change 2 units to 1

 +6       ;IHS/ASDS/LSLS - 06/04/01 - V2.4 Patch 5 - NOIS OWF-0601-190005

 +7       ;    Modified line 37 to allow 10 digits in 24k instead of 9

 +8       ;

 +9       ;IHS/SD/SDR - 11/6/2003 - v2.5 p4 - IM11164

 +10      ;    Modified line 37 to tab to 70 instead of 71 so all 10 digits

 +11      ;    will print.

 +12      ;

 +13      ; IHS/SD/SDR - v2.5 p9 - IM16769

 +14      ;    Added changes for Maine Medicaid

 +15      ;

 +16      ; IHS/SD/SDR - v2.5 p9 - IM16876

 +17      ;    (cont) removed from block 28/30 if payment

 +18      ;

 +19      ; IHS/SD/SDR - v2.5 p10 - IM20006/IM20245

 +20      ;   Alignment of FL5(phone#), FL24D, and FL24G

 +21      ;

 +22      ; IHS/SD/SDR - v2.5 p10 - IM21351

 +23      ;    Extended block 33 group number to hold 13 characters

 +24      ;

 +25      ; Import Array: ABMF(line #) = piece 1 ^ piece 2 ^....

 +26      ;         where: line # is the printable horizontal row

 +27      ;                piece is the data element to be printed

 +28      ;

 +29      ; Objective: Print designated form using data contained in the

 +30      ;            ABMF array.

 +31      ;

MARG      ;Set left and top margins

 +1        SET (ABM("LM"),ABM("TM"),ABM("LN"))=0

 +2        IF $GET(IOT)'="HFS"

               SET ABM("TM")=$PIECE(^ABMDEXP(14,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        IF $GET(ABMP("INS"))

               DO OVER

 +6       ;

LOOP      ;Loop thru line number array

 +1        SET ABM("LN")=$ORDER(ABMF(ABM("LN")))

           IF +ABM("LN")=0!(ABM("LN")>56)

               GOTO XIT

 +2       ;

 +3       ;Check for invalid line numbers

 +4        FOR ABM("I")=2,4,6,8,10,12,14,16,18,20,21,22,24,26,28,30,32,34,35,48,55,56,57

               IF ABM("LN")=ABM("I")

                   QUIT 

 +5       IF $TEST

               GOTO LOOP

 +6       ;

 +7       ;Set to correct format line

 +8        SET ABM("FL")=ABM("LN")

 +9        IF ABM("LN")>35

               IF (ABM("LN")<48)

                   IF $LENGTH(ABMF(ABM("LN")),"^")<3

                       SET ABM("FL")=36

 +10       IF ABM("LN")>35

               IF (ABM("LN")<48)

                   IF $LENGTH(ABMF(ABM("LN")),"^")>3

                       SET ABM("FL")=37

 +11      ;

 +12      ;Set tab & format variables

 +13       SET ABM("TABS")=$PIECE($TEXT(@ABM("FL")),";;",2)

 +14       SET ABM("FMAT")=$PIECE($TEXT(@ABM("FL")),";;",3)

 +15      ;

 +16      ;Added NE Medicaid code for W0047 to print first

 +17       IF $PIECE(ABMF(17),U,4)["NEBRASKA MEDICAID"

               IF ABMP("VTYP")=131

                   Begin DoDot:1

 +18                   FOR ABMLOOP=37:2:47

                           Begin DoDot:2

 +19                           IF '$DATA(ABMF(ABMLOOP))

                                   QUIT 

 +20                           SET ABMCHK=$TRANSLATE($PIECE(ABMF(ABMLOOP),U,5)," ","")

 +21                           IF ABMCHK["W0047"

                                   IF ABMLOOP'=37

                                       Begin DoDot:3

 +22                                       SET ABMF("TMP")=$GET(ABMF(37))

 +23                                       SET ABMF(37)=$GET(ABMF(ABMLOOP))

 +24                                       SET ABMF(ABMLOOP)=$GET(ABMF("TMP"))

                                       End DoDot:3

                           End DoDot:2

                   End DoDot:1

 +25       KILL ABMLOOP,ABMCHK,ABMF("TMP")

 +26      ;

 +27      ;Skip to req'd line

 +28       FOR 

               IF $Y-ABM("TM")>(ABM("LN")+5)

                   QUIT 

               WRITE !

               Begin DoDot:1

 +29               IF ($Y-ABM("TM")<1)!($Y-ABM("TM")>5)

                       QUIT 

 +30               IF $DATA(ABMF("TEST"))

                       QUIT 

 +31               IF $Y-ABM("TM")=5

                       WRITE ?1,"XXX",?76,"XXX"

                       QUIT 

 +32               IF '$DATA(ABMP("INS"))

                       QUIT 

                   KILL ABM("INS")

 +33               IF ($Y-ABM("TM"))=1

                       Begin DoDot:2

 +34                       SET ABM("J")=ABMP("BDFN")

                           SET ABM("I")=$PIECE(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")

 +35                       SET ABM("INS",ABM("I"),ABM("J"))=$SELECT(ABM("I")["NON-BENEFICIARY PATIENT":$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",5),1:"")

 +36                       DO BADDR^ABMDLBL1

 +37                       WRITE ?33,"To:"

                       End DoDot:2

 +38               IF '$DATA(ABM("ADD"))

                       QUIT 

 +39               WRITE ?37,$PIECE(ABM("ADD"),U,($Y-ABM("TM")))

               End DoDot:1

 +40      ;

 +41      ; Test Modes for setting Data Fields

 +42       IF '$DATA(ABMF("TEST"))

               GOTO LOOP2

 +43       FOR ABM("I")=1:1:$LENGTH(ABM("FMAT"),U)

               IF $PIECE(ABM("TABS"),U,ABM("I"))]""

                   SET ABM("FLD")=""

                   SET $PIECE(ABM("FLD"),"X",$PIECE(ABM("FMAT"),U,ABM("I"))+1)=""

                   IF ABM("FLD")]""

                       WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))

                       DO FRMT

 +44       GOTO LOOP

 +45      ;

LOOP2     ;Loop thru the pieces of the line array

 +1        FOR ABM("I")=1:1:$LENGTH(ABMF(ABM("LN")),U)

               Begin DoDot:1

 +2                IF '+$PIECE(ABM("TABS"),U,ABM("I"))

                       QUIT 

 +3                IF ABM("LN")>30

                       IF (ABM("LN")<34)

                           IF (ABM("I")<3)

                               IF ($PIECE(ABMF(17),U,4)["MAINE MEDICAID")

                                   Begin DoDot:2

 +4                                    SET $PIECE(ABMF(ABM("LN")),U,ABM("I"))=$TRANSLATE($PIECE(ABMF(ABM("LN")),U,ABM("I")),".","")

                                   End DoDot:2

 +5       ;if Maine Medicaid take commas of out box 24E

 +6                IF ABM("LN")>36

                       IF (ABM("LN")<48)

                           IF (ABM("I")=6)

                               IF ($PIECE(ABMF(17),U,4)["MAINE MEDICAID")

                                   Begin DoDot:2

 +7                                    SET $PIECE(ABMF(ABM("LN")),U,ABM("I"))=$TRANSLATE($PIECE(ABMF(ABM("LN")),U,ABM("I")),",","")

                                   End DoDot:2

 +8                SET ABM("FLD")=$PIECE(ABMF(ABM("LN")),U,ABM("I"))

 +9                IF $GET(ABMP("PTOT"))'=1

                       IF ($DATA(ABMP("MORE")))

                           IF (ABM("LN")=49)

                               IF (ABM("I")=7!(ABM("I")=9))

                                   SET ABM("FLD")=$GET(ABM("LTOT"))

 +10               IF ABM("FLD")]""

                       WRITE ?($PIECE(ABM("TABS"),U,ABM("I"))+ABM("LM"))

                       DO FRMT

 +11      ;Put "cont" in total charges box if multi page.

 +12               IF $DATA(ABMR("MORE"))

                       IF ABM("LN")=49

                           IF ABM("I")=7

                               IF $GET(ABMP("PTOT"))=1

                                   WRITE ?52,"(CONT.)"

               End DoDot:1

 +13       GOTO LOOP

 +14      ;

 +15      ;Write the field in the designated format

FRMT       SET ABM("LTH")=$PIECE(ABM("FMAT"),U,ABM("I"))

           IF +ABM("LTH")=0

               SET ABM("LTH")=99

 +1        IF ABM("LTH")["$"

               SET ABM("LTH")=$PIECE(ABM("LTH"),"$")

               WRITE $JUSTIFY($FNUMBER(+ABM("FLD"),",",2),ABM("LTH"))

               IF ABM("LN")'=49

                   SET ABM("LTOT")=+$GET(ABM("LTOT"))+ABM("FLD")

               QUIT 

 +2       ;if Maine Medicaid take spaces out of dates

 +3        IF $PIECE(ABMF(17),U,4)["MAINE MEDICAID"

               IF (ABM("LTH")["D")

                   SET ABM("LTH")=$PIECE(ABM("LTH"),"D")

                   WRITE $EXTRACT(ABM("FLD"),4,5),$EXTRACT(ABM("FLD"),6,7),$EXTRACT(ABM("FLD"),1,3)+1700

                   QUIT 

 +4        IF ABM("LTH")["D"

               SET ABM("LTH")=$PIECE(ABM("LTH"),"D")

               WRITE $EXTRACT(ABM("FLD"),4,5)," ",$EXTRACT(ABM("FLD"),6,7)," ",$EXTRACT(ABM("FLD"),1,3)+1700

               QUIT 

 +5        IF ABM("LTH")["Y"

               SET ABM("LTH")=$PIECE(ABM("LTH"),"Y")

               WRITE $EXTRACT(ABM("FLD"),4,7),$EXTRACT(ABM("FLD"),1,3)+1700

               QUIT 

 +6        IF ABM("LTH")["L"

               SET ABM("LTH")=$PIECE(ABM("LTH"),"L")

               FOR 

                   IF $LENGTH(ABM("FLD"))=ABM("LTH")!($LENGTH(ABM("FLD"))>ABM("LTH"))

                       QUIT 

                   SET ABM("FLD")="0"_ABM("FLD")

 +7        IF ABM("LTH")["C"

               SET ABM("LTH")=$PIECE(ABM("LTH"),"C")

               SET ABM("FLD")=$JUSTIFY("",ABM("LTH")-$LENGTH(ABM("FLD"))\2)_ABM("FLD")

 +8        IF ABM("LTH")["R"

               SET ABM("LTH")=$PIECE(ABM("LTH"),"R")

               SET ABM("RT")=ABM("LTH")-$LENGTH(ABM("FLD"))+1

               IF ABM("RT")>1

                   SET ABM("BLNK")=""

                   SET $PIECE(ABM("BLNK")," ",ABM("RT"))=""

                   SET ABM("FLD")=ABM("BLNK")_ABM("FLD")

 +9        WRITE $EXTRACT(ABM("FLD"),1,ABM("LTH"))

 +10       QUIT 

 +11      ;

TEST       SET ABMF("TEST")=1

 +1        FOR ABM=0:ABMF("TEST"):60

               SET ABMF(ABM)=""

 +2        GOTO MARG

 +3       ;

OVER      ;GET OVRRIDE VALUES FROM 3P INSURER FILE

 +1        SET ABMOLN=0

           FOR 

               SET ABMOLN=$ORDER(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN))

               IF 'ABMOLN

                   QUIT 

               Begin DoDot:1

 +2                SET ABMOPC=0

                   FOR 

                       SET ABMOPC=$ORDER(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC))

                       IF 'ABMOPC

                           QUIT 

                       Begin DoDot:2

 +3                        KILL ABMOVTYP

 +4                        IF $DATA(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC,0))

                               SET ABMOVTYP=0

 +5                        IF $DATA(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC,ABMP("VTYP")))

                               SET ABMOVTYP=ABMP("VTYP")

 +6                        IF '$DATA(ABMOVTYP)

                               QUIT 

 +7                        SET ABMVALUE=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",14,ABMOLN,ABMOPC,ABMOVTYP)

 +8                        IF ABMOLN>36

                               IF ABMOLN<49

                                   NEW I

                                   FOR I=37:2:47

                                       Begin DoDot:3

 +9                                        IF '$DATA(ABMF(I))

                                               QUIT 

 +10                                       IF $LENGTH(ABMF(I),"^")<3

                                               QUIT 

 +11                                       SET $PIECE(ABMF(I),"^",ABMOPC)=ABMVALUE

                                       End DoDot:3

 +12                       IF ABMOLN>36

                               IF ABMOLN<49

                                   QUIT 

 +13                       SET $PIECE(ABMF(ABMOLN),"^",ABMOPC)=ABMVALUE

                       End DoDot:2

               End DoDot:1

 +14       KILL ABMOLN,ABMOPC,ABMVALUE,ABMOVTYP

 +15       QUIT 

XIT        KILL ABM

 +1        IF '$DATA(ABMR("MORE"))

               KILL ABMF

 +2        QUIT 

TEXT      ;;TABS;;FIELD LENGTH

 +1       ;            FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)

1         ;;1^8^15^24^31^39^45^50;;1^1^1^1^1^1^1^29C

3         ;;1^31^42^47^50;;28^10D^1^1^29C

5         ;;1^33^38^42^47^50;;28^1^1^1^1^29C

7         ;;1^27^35^41^47^50^75;;24^2^1^1^1^23C^2

9         ;;1^14^35^41^47^50^64;;12^14^1^1^1^12C^14

11        ;;1^50;;28^29C

13        ;;1^35^41^54^68^75;;28^1^1^10D^1^1

15        ;;2^18^24^35^41^46^50;;10D^1^1^1^1^2^29C

17        ;;1^35^41^50;;28C^1^1^29C

19        ;;1^30^52^57;;28C^19C^1^1

23        ;;6^37^56;;24C^10D^23

25        ;;2^37^54^68;;10D^10D^10D^10D

27        ;;1^28^54^68;;26^21C^10D^10D

29        ;;1^52^57^62;;48^1^1^8$

31        ;;3^30^50;;25^19^29

33        ;;3^30^50;;25^19^29C

36        ;;25^71;;16^9

37        ;;1^10^19^22^25^42^50^59^62^65^68^70;;8Y^8Y^2R^2R^16^7C^8$^3R^2R^2R^2R^10

49        ;;1^17^19^23^38^43^50^61^71;;15^1^1^14C^1^1^10$^9$^8$

50        ;;65;;14

51        ;;23^50;;26^29

52        ;;1^23^50;;21^26^29

53        ;;1^23^50;;21^26^29

54        ;;12^23^49^67;;10D^26^13R^13C