Routine: ABMDF35A

ABMDF35A ; IHS/SD/SDR - Set HCFA-1500 (02/12) Print Array ;

 ;;2.6;IHS Third Party Billing;**13**;NOV 12, 2009;Build 213

ENT ;

 K ABMF,ABM,ABMU,ABMR,ABMS

 S ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)       ;0 node bill file

 S ABMP("INS")=$P(ABMP("B0"),U,8)                    ;Active insurer IEN

 Q:'ABMP("INS")                                      ;q:no active ins

 S ABMP("PDFN")=$P(ABMP("B0"),U,5)                   ;Patient IEN

 S ABMP("LDFN")=$P(ABMP("B0"),U,3)                   ;Visit Location IEN

 Q:'ABMP("PDFN")!('+ABMP("LDFN"))                    ;q:no pat or loc

 S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)  ;Srv date from

 S ABMP("BTYP")=$P(ABMP("B0"),"^",2)                 ;Bill type

 S ABMP("VTYP")=$P(ABMP("B0"),"^",7)                 ;Visit Type IEN

 S (ABMP("CLN"),ABMP("CLIN"))=$P(ABMP("B0"),"^",10)                ;clinic

 S ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")  ; Type of ins.

 S ABMP("NPIS")=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))

 S (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""

 D PAT^ABMDE1X                        ; returns ABMV("X2") array

 D REMPL^ABMDE1X1                     ; returns ABMV("X3") array

 D LOC^ABMDE1X1                       ; returns ABMV("X1") array

 K ABME

BLOC ;

 S ABMF(50)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,11)  ; Facility phone

 ; Billing Name

 S $P(ABMF(51),"^",2)=$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)

 I $P(ABMF(51),"^",2)="" D

 .S $P(ABMF(51),U,2)=$S($P($G(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$P(^(2),U,6),$P($P(ABMV("X1"),U,2),"C/O ",2)]"":$P($P(ABMV("X1"),U,2),"C/O ",2),1:$P($P(ABMV("X1"),U),";",2))

 S $P(ABMF(52),U,3)=$P(ABMV("X1"),U,3)   ; Billing Address

 S $P(ABMF(53),U,3)=$TR($P(ABMV("X1"),U,4),",")   ; Billing City,State Zip

 S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))

 S $P(ABMF(54),U,2)=$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)

 I ($P($G(^DIC(40.7,ABMP("CLIN"),0)),U,2)=72)&($P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)'="") S $P(ABMF(54),U,2)=$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)

 I ABMP("ITYPE")="R"&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N") S $P(ABMF(54),U,3)=$S($$MCR^ABMUTLF(ABMP("LDFN"))'="":"1C"_$$MCR^ABMUTLF(ABMP("LDFN")),1:"")

 I (ABMP("ITYPE")="D"!(ABMP("ITYPE")="K"))&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N") S $P(ABMF(54),U,3)=$S($$MCD^ABMUTLF(ABMP("LDFN"))'="":"1D"_$$MCD^ABMUTLF(ABMP("LDFN")),1:"")

 I (ABMP("ITYPE")'="R"&(ABMP("ITYPE")'="D")&(ABMP("ITYPE")'="K"))&(ABMP("NPIS")'="N") D

 .S ABMIDCD=""

 .D PIREFID^ABME8L2

 .S $P(ABMF(54),U,3)=$S($$PI^ABMUTLF(ABMP("LDFN"))'="":ABMIDCD_$$PI^ABMUTLF(ABMP("LDFN")),1:"")

 I $G(ABMP("NPIS"))="N"&(($P($G(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($P($G(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT")) D

 .S $P(ABMF(54),U,3)=""

 E  I (ABMP("NPIS")="N") S $P(ABMF(54),U,3)="ZZ"_$$PTAX^ABMUTLF(ABMP("LDFN"))

VLOC ;

 S $P(ABMF(51),U)=$P(^DIC(4,ABMP("LDFN"),0),U)

 I $G(ABMP("CLIN"))'="",($P($G(^DIC(40.7,ABMP("CLIN"),0)),U)["AMBULANCE") S $P(ABMF(51),U)="ORIGIN: "_$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,2)

 I $D(^DIC(4,ABMP("LDFN"),1)) D

 .S ABMVLOC=^DIC(4,ABMP("LDFN"),1)

 .S $P(ABMF(52),"^",2)=$P(ABMVLOC,U)

 .S $P(ABMF(53),U,2)=$TR($$CSZ^ABMDUTL($P(ABMVLOC,"^",3)_"^"_$P(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$P(ABMVLOC,"^",4)),",")

 .K ABMVLOC

 I '$D(^DIC(4,ABMP("LDFN"),1)) D

 .S $P(ABMF(52),U,2)=$P(^AUTTLOC(ABMP("LDFN"),0),U,12)

 .S $P(ABMF(53),U,2)=$TR($$CSZ^ABMDUTL($P(^AUTTLOC(ABMP("LDFN"),0),U,13,15)),",")

 I $P($G(^DIC(40.7,$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U)["AMBULANCE" D

 .S ABMDREC=$$GETDEST^ABMDE31($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7))

 .S $P(ABMF(52),U,2)="DESTINATION: "_$P(ABMDREC,U)

BNUM ;

 S $P(ABMF(49),U,4)=$P(ABMP("B0"),U)_$S($P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,4)]"":"-"_$P(^ABMDPARM(ABMP("LDFN"),1,2),U,4),1:"")

 I $P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,3),($P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)) S $P(ABMF(49),U,4)=$P(ABMF(49),U,4)_"-"_$P(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2)

INSNUM ;

 ;GET PROVIDER NUMBER

 S ABM("INUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)

 I ABM("INUM")="" D

 .S ABM("I")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$P(ABMP("B0"),U,7),0)),U,6)

 .S ABM("INUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$S(ABM("I")="Y":999,1:$P(ABMP("B0"),U,7)),0)),U,8)

 S:ABM("INUM")="" ABM("INUM")=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)

 S:(ABMP("NPIS")'="N") $P(ABMF(54),U,5)=ABM("INUM")

 S ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")

 I ABM("ITYP")="R"&(ABMP("NPIS")'="N") S $P(ABMF(54),U,5)=$P(^AUTTLOC(ABMP("LDFN"),0),U,19)

 S ABM("ITYP")=$S(ABM("ITYP")="R":1,ABM("ITYP")="D":2,ABM("ITYP")="C":3,1:7)

 I $P($G(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID" S ABM("ITYP")=5

 S $P(ABMF(1),U,ABM("ITYP"))="X"

TAX ;

 S $P(ABMF(49),U,1)=$P(ABMV("X1"),U,6)

 I $P($G(^AUTNINS(ABMP("INS"),0)),U)["VMBP"  D

 .I DUZ(2)=2248 S $P(ABMF(49),U,1)="364587378"  ;Crow Hospital

 .I DUZ(2)=2299 S $P(ABMF(49),U,1)="371522894"  ;Fort Belknap

 .I DUZ(2)=2311 S $P(ABMF(49),U,1)="364587381"  ;Fort Peck

 .I DUZ(2)=2348 S $P(ABMF(49),U,1)="364587379"  ;Lame Deer

 .I DUZ(2)=2336 S $P(ABMF(49),U,1)="364587384"  ;Fort Washakie

 S:$P(ABMV("X1"),U,6)]"" $P(ABMF(49),U,3)="X"

 S $P(ABMF(49),U,5)="X"

PNODES ;

 ;PATIENT INFO

 D ISET^ABMERUTL             ; Needed to get medicaid name from ABMER20A

 D PNM^ABMER20A

 S ABM("P0")=ABME("PNM")

 S $P(ABM("P0"),"^",3)=ABME("DOB")

NAME ;

 S ABMF(3)=$P(ABM("P0"),U)

ADDRESS ;

 S $P(ABMF(5),U)=$P(ABMV("X2"),U,3)

 S $P(ABMF(7),U)=$P($P(ABMV("X2"),U,4),", ")

 S $P(ABMF(7),U,2)=$P($P($P(ABMV("X2"),U,4),", ",2),"  ")

 S $P(ABMF(9),U)=$P($P($P(ABMV("X2"),U,4),", ",2),"  ",2)

 S $P(ABMF(9),U,2)=$S($E($P(ABMV("X2"),U,5))="(":"",1:" ")_$P(ABMV("X2"),U,5)

DOB ;

 S $P(ABMF(3),U,2)=$P(ABM("P0"),U,3)

SEX ;

 I $P(ABMV("X2"),U,2)="M" S $P(ABMF(3),U,3)="X"

 E  S $P(ABMF(3),U,4)="X"

 K ABM("P0")

 ;I $P(^AUPNPAT(ABMP("PDFN"),0),U,21),"1246"[$P(^(0),U,21) S $P(ABMF(9),U,3)="X"  ;abm*2.6*13 remove box 8

 I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)'="" S $P(ABMF(31),U,5)=$P(^(4),U,9)

XIT ;

 K ABM,ABMX,ABMV

ABMDF35A  ; IHS/SD/SDR - Set HCFA-1500 (02/12) Print Array ;

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

 +2       ;

ENT       ;

 +1        KILL ABMF,ABM,ABMU,ABMR,ABMS

 +2       ;0 node bill file

           SET ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)

 +3       ;Active insurer IEN

           SET ABMP("INS")=$PIECE(ABMP("B0"),U,8)

 +4       ;q:no active ins

           IF 'ABMP("INS")

               QUIT

 +5       ;Patient IEN

           SET ABMP("PDFN")=$PIECE(ABMP("B0"),U,5)

 +6       ;Visit Location IEN

           SET ABMP("LDFN")=$PIECE(ABMP("B0"),U,3)

 +7       ;q:no pat or loc

           IF 'ABMP("PDFN")!('+ABMP("LDFN"))

               QUIT

 +8       ;Srv date from

           SET ABMP("VDT")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)

 +9       ;Bill type

           SET ABMP("BTYP")=$PIECE(ABMP("B0"),"^",2)

 +10      ;Visit Type IEN

           SET ABMP("VTYP")=$PIECE(ABMP("B0"),"^",7)

 +11      ;clinic

           SET (ABMP("CLN"),ABMP("CLIN"))=$PIECE(ABMP("B0"),"^",10)

 +12      ; Type of ins.

           SET ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")

 +13       SET ABMP("NPIS")=$$NPIUSAGE^ABMUTLF(ABMP("LDFN"),ABMP("INS"))

 +14       SET (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""

 +15      ; returns ABMV("X2") array

           DO PAT^ABMDE1X

 +16      ; returns ABMV("X3") array

           DO REMPL^ABMDE1X1

 +17      ; returns ABMV("X1") array

           DO LOC^ABMDE1X1

 +18       KILL ABME

 +19      ;

BLOC      ;

 +1       ; Facility phone

           SET ABMF(50)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,11)

 +2       ; Billing Name

 +3        SET $PIECE(ABMF(51),"^",2)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),"^",6)

 +4        IF $PIECE(ABMF(51),"^",2)=""

               Begin DoDot:1

 +5                SET $PIECE(ABMF(51),U,2)=$SELECT($PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,6)]"":$PIECE(^(2),U,6),$PIECE($PIECE(ABMV("X1"),U,2),"C/O ",2)]"":$PIECE($PIECE(ABMV("X1"),U,2),"C/O ",2),1:$PIECE($PIECE(ABMV("X1"),U),";",2))

               End DoDot:1

 +6       ; Billing Address

           SET $PIECE(ABMF(52),U,3)=$PIECE(ABMV("X1"),U,3)

 +7       ; Billing City,State Zip

           SET $PIECE(ABMF(53),U,3)=$TRANSLATE($PIECE(ABMV("X1"),U,4),",")

 +8       SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":...

           ... $PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))

 +9        SET $PIECE(ABMF(54),U,2)=$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)

 +10       IF ($PIECE($GET(^DIC(40.7,ABMP("CLIN"),0)),U,2)=72)&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)'="")

               SET $PIECE(ABMF(54),U,2)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,4)

 +11       IF ABMP("ITYPE")="R"&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N")

               SET $PIECE(ABMF(54),U,3)=$SELECT($$MCR^ABMUTLF(ABMP("LDFN"))'="":"1C"_$$MCR^ABMUTLF(ABMP("LDFN")),1:"")

 +12       IF (ABMP("ITYPE")="D"!(ABMP("ITYPE")="K"))&(ABMP("NPIS")'="")&(ABMP("NPIS")'="N")

               SET $PIECE(ABMF(54),U,3)=$SELECT($$MCD^ABMUTLF(ABMP("LDFN"))'="":"1D"_$$MCD^ABMUTLF(ABMP("LDFN")),1:"")

 +13       IF (ABMP("ITYPE")'="R"&(ABMP("ITYPE")'="D")&(ABMP("ITYPE")'="K"))&(ABMP("NPIS")'="N")

               Begin DoDot:1

 +14               SET ABMIDCD=""

 +15               DO PIREFID^ABME8L2

 +16               SET $PIECE(ABMF(54),U,3)=$SELECT($$PI^ABMUTLF(ABMP("LDFN"))'="":ABMIDCD_$$PI^ABMUTLF(ABMP("LDFN")),1:"")

               End DoDot:1

 +17       IF $GET(ABMP("NPIS"))="N"&(($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="NEW MEXICO MEDICAID")!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="MEDICAID EXEMPT"))

               Begin DoDot:1

 +18               SET $PIECE(ABMF(54),U,3)=""

               End DoDot:1

 +19      IF '$TEST

               IF (ABMP("NPIS")="N")

                   SET $PIECE(ABMF(54),U,3)="ZZ"_$$PTAX^ABMUTLF(ABMP("LDFN"))

 +20      ;

VLOC      ;

 +1        SET $PIECE(ABMF(51),U)=$PIECE(^DIC(4,ABMP("LDFN"),0),U)

 +2        IF $GET(ABMP("CLIN"))'=""

               IF ($PIECE($GET(^DIC(40.7,ABMP("CLIN"),0)),U)["AMBULANCE")

                   SET $PIECE(ABMF(51),U)="ORIGIN: "_$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,2)

 +3        IF $DATA(^DIC(4,ABMP("LDFN"),1))

               Begin DoDot:1

 +4                SET ABMVLOC=^DIC(4,ABMP("LDFN"),1)

 +5                SET $PIECE(ABMF(52),"^",2)=$PIECE(ABMVLOC,U)

 +6                SET $PIECE(ABMF(53),U,2)=$TRANSLATE($$CSZ^ABMDUTL($PIECE(ABMVLOC,"^",3)_"^"_$PIECE(^DIC(4,ABMP("LDFN"),0),"^",2)_"^"_$PIECE(ABMVLOC,"^",4)),",")

 +7                KILL ABMVLOC

               End DoDot:1

 +8        IF '$DATA(^DIC(4,ABMP("LDFN"),1))

               Begin DoDot:1

 +9                SET $PIECE(ABMF(52),U,2)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,12)

 +10               SET $PIECE(ABMF(53),U,2)=$TRANSLATE($$CSZ^ABMDUTL($PIECE(^AUTTLOC(ABMP("LDFN"),0),U,13,15)),",")

               End DoDot:1

 +11       IF $PIECE($GET(^DIC(40.7,$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,10),0)),U)["AMBULANCE"

               Begin DoDot:1

 +12               SET ABMDREC=$$GETDEST^ABMDE31($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,7))

 +13               SET $PIECE(ABMF(52),U,2)="DESTINATION: "_$PIECE(ABMDREC,U)

               End DoDot:1

 +14      ;

BNUM      ;

 +1        SET $PIECE(ABMF(49),U,4)=$PIECE(ABMP("B0"),U)_$SELECT($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,4)]"":"-"_$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,4),1:"")

 +2        IF $PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,3)

               IF ($PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2))

                   SET $PIECE(ABMF(49),U,4)=$PIECE(ABMF(49),U,4)_"-"_$PIECE(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0),U,2)

 +3       ;

INSNUM    ;

 +1       ;GET PROVIDER NUMBER

 +2        SET ABM("INUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)

 +3        IF ABM("INUM")=""

               Begin DoDot:1

 +4                SET ABM("I")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$PIECE(ABMP("B0"),U,7),0)),U,6)

 +5                SET ABM("INUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$SELECT(ABM("I")="Y":999,1:$PIECE(ABMP("B0"),U,7)),0)),U,8)

               End DoDot:1

 +6        IF ABM("INUM")=""

               SET ABM("INUM")=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)

 +7        IF (ABMP("NPIS")'="N")

               SET $PIECE(ABMF(54),U,5)=ABM("INUM")

 +8        SET ABM("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")

 +9        IF ABM("ITYP")="R"&(ABMP("NPIS")'="N")

               SET $PIECE(ABMF(54),U,5)=$PIECE(^AUTTLOC(ABMP("LDFN"),0),U,19)

 +10       SET ABM("ITYP")=$SELECT(ABM("ITYP")="R":1,ABM("ITYP")="D":2,ABM("ITYP")="C":3,1:7)

 +11       IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="PHC MEDICAID"

               SET ABM("ITYP")=5

 +12       SET $PIECE(ABMF(1),U,ABM("ITYP"))="X"

 +13      ;

TAX       ;

 +1        SET $PIECE(ABMF(49),U,1)=$PIECE(ABMV("X1"),U,6)

 +2        IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["VMBP"

               Begin DoDot:1

 +3       ;Crow Hospital

                   IF DUZ(2)=2248

                       SET $PIECE(ABMF(49),U,1)="364587378"

 +4       ;Fort Belknap

                   IF DUZ(2)=2299

                       SET $PIECE(ABMF(49),U,1)="371522894"

 +5       ;Fort Peck

                   IF DUZ(2)=2311

                       SET $PIECE(ABMF(49),U,1)="364587381"

 +6       ;Lame Deer

                   IF DUZ(2)=2348

                       SET $PIECE(ABMF(49),U,1)="364587379"

 +7       ;Fort Washakie

                   IF DUZ(2)=2336

                       SET $PIECE(ABMF(49),U,1)="364587384"

               End DoDot:1

 +8        IF $PIECE(ABMV("X1"),U,6)]""

               SET $PIECE(ABMF(49),U,3)="X"

 +9        SET $PIECE(ABMF(49),U,5)="X"

 +10      ;

PNODES    ;

 +1       ;PATIENT INFO

 +2       ; Needed to get medicaid name from ABMER20A

           DO ISET^ABMERUTL

 +3        DO PNM^ABMER20A

 +4        SET ABM("P0")=ABME("PNM")

 +5        SET $PIECE(ABM("P0"),"^",3)=ABME("DOB")

 +6       ;

NAME      ;

 +1        SET ABMF(3)=$PIECE(ABM("P0"),U)

 +2       ;

ADDRESS   ;

 +1        SET $PIECE(ABMF(5),U)=$PIECE(ABMV("X2"),U,3)

 +2        SET $PIECE(ABMF(7),U)=$PIECE($PIECE(ABMV("X2"),U,4),", ")

 +3        SET $PIECE(ABMF(7),U,2)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2),"  ")

 +4        SET $PIECE(ABMF(9),U)=$PIECE($PIECE($PIECE(ABMV("X2"),U,4),", ",2),"  ",2)

 +5        SET $PIECE(ABMF(9),U,2)=$SELECT($EXTRACT($PIECE(ABMV("X2"),U,5))="(":"",1:" ")_$PIECE(ABMV("X2"),U,5)

 +6       ;

DOB       ;

 +1        SET $PIECE(ABMF(3),U,2)=$PIECE(ABM("P0"),U,3)

 +2       ;

SEX       ;

 +1        IF $PIECE(ABMV("X2"),U,2)="M"

               SET $PIECE(ABMF(3),U,3)="X"

 +2       IF '$TEST

               SET $PIECE(ABMF(3),U,4)="X"

 +3        KILL ABM("P0")

 +4       ;I $P(^AUPNPAT(ABMP("PDFN"),0),U,21),"1246"[$P(^(0),U,21) S $P(ABMF(9),U,3)="X"  ;abm*2.6*13 remove box 8

 +5        IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4)),U,9)'=""

               SET $PIECE(ABMF(31),U,5)=$PIECE(^(4),U,9)

 +6       ;

XIT       ;

 +1        KILL ABM,ABMX,ABMV

 +2        QUIT

ABMDF35A.m