ABMEH32.m

ABMEH32 ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD DA2 (Insurance Information) ;   

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

 ;

 ; IHS/ASDS/DMJ - 03/26/01 - V2.4 P5 - HQW-0301-100073

 ;       Modified to put state abbrev. in DA2

 ;

START ;START HERE

 K ABMR(32),ABMREC(32,ABME("S#"))

 S ABME("RTYPE")=32       ; Record type

 D SET^ABMERUTL,LOOP

 D S90^ABMERUTL           ; Increment record type counter

 Q

 ;

LOOP ;LOOP HERE

 F I=10:10:200 D

 .D @I

 .I $D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),32,I)) D @(^(I))

 .I '$G(ABMP("NOFMT")) S ABMREC(32,ABME("S#"))=$G(ABMREC(32,ABME("S#")))_ABMR(32,I)

 Q

 ;

10 ;1-3 Record ID

 S ABMR(32,10)="DA2"

 Q

 ;

20 ;4-5 Sequence #

 S ABMR(32,20)="0"_ABME("S#")

 S ABMR(32,20)=$$FMT^ABMERUTL(ABMR(32,20),2)

 Q

 ;

30 ;6-22 Patient Control Number

 S ABMR(32,30)=ABMP("PCN")

 S ABMR(32,30)=$$FMT^ABMERUTL(ABMR(32,30),17)

 Q

 ;

40 ;23-52 Insured's Address Line 1

 S ABMR(32,40)=""

 I $G(ABME("PPP")) D               ; from patient file

 .S ABME("FLD")=.111

 .D DIQ4^ABMER31A

 .S ABMR(32,40)=$G(ABM(2,ABME("PPP"),.111,"E"))

 I ABMR(32,40)="",$G(ABME("PH")) D  ; else policy holder file

 .S ABME("FLD")=.09

 .D DIQ1^ABMER31A

 .S ABMR(32,40)=$G(ABM(9000003.1,+ABME("PH"),.09,"E"))

 S ABMR(32,40)=$$FMT^ABMERUTL(ABMR(32,40),30)

 Q

 ;

50 ;53-82 Insured's Address Line 2

 S ABMR(32,50)=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.112

 .D DIQ4^ABMER31A

 .S ABMR(32,50)=$G(ABM(2,ABME("PPP"),.112,"E"))

 S ABMR(32,50)=$$FMT^ABMERUTL(ABMR(32,50),30)

 Q

 ;

60 ;83-102 Insured's City

 S ABMR(32,60)=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.114

 .D DIQ4^ABMER31A

 .S ABMR(32,60)=$G(ABM(2,ABME("PPP"),.114,"E"))

 I ABMR(32,60)="",$G(ABME("PH")) D

 .S ABME("FLD")=.11

 .D DIQ1^ABMER31A

 .S ABMR(32,60)=$G(ABM(9000003.1,+ABME("PH"),.11,"E"))

 S ABMR(32,60)=$$FMT^ABMERUTL(ABMR(32,60),20)

 Q

 ;

70 ;103-104 Insured's State

 S ABMR(32,70)=""

 S ABME("ISTATE")=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.115

 .D DIQ4^ABMER31A

 .S ABME("ISTATE")=$G(ABM(2,ABME("PPP"),.115,"I"))

 I 'ABME("ISTATE"),$G(ABME("PH")) D

 .S ABME("FLD")=.12

 .D DIQ1^ABMER31A

 .S ABME("ISTATE")=$G(ABM(9000003.1,ABME("PH"),.12,"I"))

 S ABMR(32,70)=$P($G(^DIC(5,+ABME("ISTATE"),0)),"^",2)

 S ABMR(32,70)=$$FMT^ABMERUTL(ABMR(32,70),2)

 Q

 ;

80 ;103-113 Insured's Zip

 S ABMR(32,80)=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.116

 .D DIQ4^ABMER31A

 .S ABMR(32,80)=$G(ABM(2,ABME("PPP"),.116,"E"))

 I ABMR(32,80)="",$G(ABME("PH")) D

 .S ABME("FLD")=.13

 .D DIQ1^ABMER31A

 .S ABMR(32,80)=$G(ABM(9000003.1,ABME("PH"),.13,"E"))

 S $E(ABMR(32,80),6,9)="0000"

 S ABMR(32,80)=$$FMT^ABMERUTL(ABMR(32,80),9)

 Q

90 ;114-123 Insured Phone

 S ABMR(32,90)=""

 S ABMR(32,90)=$$FMT^ABMERUTL(ABMR(32,90),10)

 Q

100 ;124-131 Insured Retire Date

 S ABMR(32,100)=""

 S ABMR(32,100)=$$FMT^ABMERUTL(ABMR(32,100),8)

 Q

110 ;132-139 Insured Retire Date

 S ABMR(32,110)=""

 S ABMR(32,110)=$$FMT^ABMERUTL(ABMR(32,110),8)

 Q

120 ;140-172 Employer Name

 S ABMR(32,120)=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.01

 .D DIQ3^ABMER31A

 .S ABMR(32,120)=$G(ABM(9999999.75,+DA,.01,"E"))

 I ABMR(32,120)="",$G(ABME("PH")) D

 .S ABME("FLD")=.16

 .D DIQ1^ABMER31A

 .S ABMR(32,120)=$G(ABM(9000003.1,ABME("PH"),.16,"E"))

 S ABMR(32,120)=$$FMT^ABMERUTL(ABMR(32,120),33)

 Q

 ;

130 ;173-202 Employer Address 1

 S ABMR(32,130)=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.02

 .D DIQ3^ABMER31A

 .S ABMR(32,130)=$G(ABM(9999999.75,+DA,.02,"E"))

 I ABMR(32,130)="",$G(ABME("PH")) D

 .S ABME("FLD")=.02

 .D DIQ2^ABMER31A

 .S ABMR(32,130)=$G(ABM(9999999.75,+ABME("EMP"),.02,"E"))

 S ABMR(32,130)=$$FMT^ABMERUTL(ABMR(32,130),30)

 Q

140 ;203-232 Employer Address 2

 S ABMR(32,140)=""

 S ABMR(32,140)=$$FMT^ABMERUTL(ABMR(32,140),30)

 Q

150 ;233-252 Employer City

 S ABMR(32,150)=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.03

 .D DIQ3^ABMER31A

 .S ABMR(32,150)=$G(ABM(9999999.75,+DA,.03,"E"))

 I ABMR(32,150)="",$G(ABME("PH")) D

 .S ABME("FLD")=.03

 .D DIQ2^ABMER31A

 .S ABMR(32,150)=$G(ABM(9999999.75,+ABME("EMP"),.03,"E"))

 S ABMR(32,150)=$$FMT^ABMERUTL(ABMR(32,150),20)

 Q

 ;

160 ;253-254 Employer State

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.04

 .D DIQ3^ABMER31A

 .S ABME("ESTATE")=$G(ABM(9999999.75,+DA,.04,"I"))

 I '$G(ABME("ESTATE")),$G(ABME("PH")) D

 .S ABME("FLD")=.04

 .D DIQ2^ABMER31A

 .S ABME("ESTATE")=$G(ABM(9999999.75,+ABME("EMP"),.04,"I"))

 S ABMR(32,160)=$S($G(ABME("ESTATE")):$P($G(^DIC(5,ABME("ESTATE"),0)),"^",2),1:"")

 S ABMR(32,160)=$$FMT^ABMERUTL(ABMR(32,160),2)

 Q

 ;

170 ;255-263 Employer Zip

 S ABMR(32,170)=""

 I $G(ABME("PPP")) D

 .S ABME("FLD")=.05

 .D DIQ3^ABMER31A

 .S ABMR(32,170)=$G(ABM(9999999.75,+DA,.05,"E"))

 I ABMR(32,170)="",$G(ABME("PH")) D

 .S ABME("FLD")=.05

 .D DIQ2^ABMER31A

 .S ABMR(32,170)=$G(ABM(9999999.75,+ABME("EMP"),.05,"E"))

 S ABMR(32,170)=$$FMT^ABMERUTL(ABMR(32,170),9)

 Q

 ;

180 ;264-275 Employee ID #

 S ABMR(32,180)=""

 S ABMR(32,180)=$$FMT^ABMERUTL(ABMR(32,180),12)

 Q

 ;

190 ;276-300 Filler (National)

 S ABMR(32,190)=""

 S ABMR(32,190)=$$FMT^ABMERUTL(ABMR(32,190),25)

 Q

200 ;301-320 Filler (Local)

 S ABMR(32,200)=""

 S ABMR(32,200)=$$FMT^ABMERUTL(ABMR(32,200),20)

 Q

 ;

EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE

 ;

 ;  INPUT:  ABMX = data element

 ;          ABMY = bill internal entry number

 ;          ABMZ = Insurer priority (1 thru 3)

 ;

 ; OUTPUT:     Y = bill internal entry number

 ;

 S ABMP("BDFN")=ABMY

 D SET^ABMERUTL

 S ABME("INS")=ABMZ

 I '$D(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABME("INS"))) S Y="" Q Y

 D ISET^ABMERINS

 I '$G(ABMP("NOFMT")) S ABMP("FMT")=0

 D @ABMX

 S Y=ABMR(32,ABMX)

 I $D(ABMP("FMT")) S ABMP("FMT")=1

 K ABMR(32,ABMX),ABME,ABMX,ABMY,ABMZ,ABM

 Q Y

ABMEH32   ; IHS/ASDST/DMJ - HCFA-1500 EMC RECORD DA2 (Insurance Information) ;   

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

 +2       ;

 +3       ; IHS/ASDS/DMJ - 03/26/01 - V2.4 P5 - HQW-0301-100073

 +4       ;       Modified to put state abbrev. in DA2

 +5       ;

START     ;START HERE

 +1        KILL ABMR(32),ABMREC(32,ABME("S#"))

 +2       ; Record type

           SET ABME("RTYPE")=32

 +3        DO SET^ABMERUTL

           DO LOOP

 +4       ; Increment record type counter

           DO S90^ABMERUTL

 +5        QUIT 

 +6       ;

LOOP      ;LOOP HERE

 +1        FOR I=10:10:200

               Begin DoDot:1

 +2                DO @I

 +3                IF $DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),32,I))

                       DO @(^(I))

 +4                IF '$GET(ABMP("NOFMT"))

                       SET ABMREC(32,ABME("S#"))=$GET(ABMREC(32,ABME("S#")))_ABMR(32,I)

               End DoDot:1

 +5        QUIT 

 +6       ;

10        ;1-3 Record ID

 +1        SET ABMR(32,10)="DA2"

 +2        QUIT 

 +3       ;

20        ;4-5 Sequence #

 +1        SET ABMR(32,20)="0"_ABME("S#")

 +2        SET ABMR(32,20)=$$FMT^ABMERUTL(ABMR(32,20),2)

 +3        QUIT 

 +4       ;

30        ;6-22 Patient Control Number

 +1        SET ABMR(32,30)=ABMP("PCN")

 +2        SET ABMR(32,30)=$$FMT^ABMERUTL(ABMR(32,30),17)

 +3        QUIT 

 +4       ;

40        ;23-52 Insured's Address Line 1

 +1        SET ABMR(32,40)=""

 +2       ; from patient file

           IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.111

 +4                DO DIQ4^ABMER31A

 +5                SET ABMR(32,40)=$GET(ABM(2,ABME("PPP"),.111,"E"))

               End DoDot:1

 +6       ; else policy holder file

           IF ABMR(32,40)=""

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +7                    SET ABME("FLD")=.09

 +8                    DO DIQ1^ABMER31A

 +9                    SET ABMR(32,40)=$GET(ABM(9000003.1,+ABME("PH"),.09,"E"))

                   End DoDot:1

 +10       SET ABMR(32,40)=$$FMT^ABMERUTL(ABMR(32,40),30)

 +11       QUIT 

 +12      ;

50        ;53-82 Insured's Address Line 2

 +1        SET ABMR(32,50)=""

 +2        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.112

 +4                DO DIQ4^ABMER31A

 +5                SET ABMR(32,50)=$GET(ABM(2,ABME("PPP"),.112,"E"))

               End DoDot:1

 +6        SET ABMR(32,50)=$$FMT^ABMERUTL(ABMR(32,50),30)

 +7        QUIT 

 +8       ;

60        ;83-102 Insured's City

 +1        SET ABMR(32,60)=""

 +2        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.114

 +4                DO DIQ4^ABMER31A

 +5                SET ABMR(32,60)=$GET(ABM(2,ABME("PPP"),.114,"E"))

               End DoDot:1

 +6        IF ABMR(32,60)=""

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +7                    SET ABME("FLD")=.11

 +8                    DO DIQ1^ABMER31A

 +9                    SET ABMR(32,60)=$GET(ABM(9000003.1,+ABME("PH"),.11,"E"))

                   End DoDot:1

 +10       SET ABMR(32,60)=$$FMT^ABMERUTL(ABMR(32,60),20)

 +11       QUIT 

 +12      ;

70        ;103-104 Insured's State

 +1        SET ABMR(32,70)=""

 +2        SET ABME("ISTATE")=""

 +3        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +4                SET ABME("FLD")=.115

 +5                DO DIQ4^ABMER31A

 +6                SET ABME("ISTATE")=$GET(ABM(2,ABME("PPP"),.115,"I"))

               End DoDot:1

 +7        IF 'ABME("ISTATE")

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +8                    SET ABME("FLD")=.12

 +9                    DO DIQ1^ABMER31A

 +10                   SET ABME("ISTATE")=$GET(ABM(9000003.1,ABME("PH"),.12,"I"))

                   End DoDot:1

 +11       SET ABMR(32,70)=$PIECE($GET(^DIC(5,+ABME("ISTATE"),0)),"^",2)

 +12       SET ABMR(32,70)=$$FMT^ABMERUTL(ABMR(32,70),2)

 +13       QUIT 

 +14      ;

80        ;103-113 Insured's Zip

 +1        SET ABMR(32,80)=""

 +2        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.116

 +4                DO DIQ4^ABMER31A

 +5                SET ABMR(32,80)=$GET(ABM(2,ABME("PPP"),.116,"E"))

               End DoDot:1

 +6        IF ABMR(32,80)=""

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +7                    SET ABME("FLD")=.13

 +8                    DO DIQ1^ABMER31A

 +9                    SET ABMR(32,80)=$GET(ABM(9000003.1,ABME("PH"),.13,"E"))

                   End DoDot:1

 +10       SET $EXTRACT(ABMR(32,80),6,9)="0000"

 +11       SET ABMR(32,80)=$$FMT^ABMERUTL(ABMR(32,80),9)

 +12       QUIT 

90        ;114-123 Insured Phone

 +1        SET ABMR(32,90)=""

 +2        SET ABMR(32,90)=$$FMT^ABMERUTL(ABMR(32,90),10)

 +3        QUIT 

100       ;124-131 Insured Retire Date

 +1        SET ABMR(32,100)=""

 +2        SET ABMR(32,100)=$$FMT^ABMERUTL(ABMR(32,100),8)

 +3        QUIT 

110       ;132-139 Insured Retire Date

 +1        SET ABMR(32,110)=""

 +2        SET ABMR(32,110)=$$FMT^ABMERUTL(ABMR(32,110),8)

 +3        QUIT 

120       ;140-172 Employer Name

 +1        SET ABMR(32,120)=""

 +2        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.01

 +4                DO DIQ3^ABMER31A

 +5                SET ABMR(32,120)=$GET(ABM(9999999.75,+DA,.01,"E"))

               End DoDot:1

 +6        IF ABMR(32,120)=""

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +7                    SET ABME("FLD")=.16

 +8                    DO DIQ1^ABMER31A

 +9                    SET ABMR(32,120)=$GET(ABM(9000003.1,ABME("PH"),.16,"E"))

                   End DoDot:1

 +10       SET ABMR(32,120)=$$FMT^ABMERUTL(ABMR(32,120),33)

 +11       QUIT 

 +12      ;

130       ;173-202 Employer Address 1

 +1        SET ABMR(32,130)=""

 +2        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.02

 +4                DO DIQ3^ABMER31A

 +5                SET ABMR(32,130)=$GET(ABM(9999999.75,+DA,.02,"E"))

               End DoDot:1

 +6        IF ABMR(32,130)=""

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +7                    SET ABME("FLD")=.02

 +8                    DO DIQ2^ABMER31A

 +9                    SET ABMR(32,130)=$GET(ABM(9999999.75,+ABME("EMP"),.02,"E"))

                   End DoDot:1

 +10       SET ABMR(32,130)=$$FMT^ABMERUTL(ABMR(32,130),30)

 +11       QUIT 

140       ;203-232 Employer Address 2

 +1        SET ABMR(32,140)=""

 +2        SET ABMR(32,140)=$$FMT^ABMERUTL(ABMR(32,140),30)

 +3        QUIT 

150       ;233-252 Employer City

 +1        SET ABMR(32,150)=""

 +2        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.03

 +4                DO DIQ3^ABMER31A

 +5                SET ABMR(32,150)=$GET(ABM(9999999.75,+DA,.03,"E"))

               End DoDot:1

 +6        IF ABMR(32,150)=""

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +7                    SET ABME("FLD")=.03

 +8                    DO DIQ2^ABMER31A

 +9                    SET ABMR(32,150)=$GET(ABM(9999999.75,+ABME("EMP"),.03,"E"))

                   End DoDot:1

 +10       SET ABMR(32,150)=$$FMT^ABMERUTL(ABMR(32,150),20)

 +11       QUIT 

 +12      ;

160       ;253-254 Employer State

 +1        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +2                SET ABME("FLD")=.04

 +3                DO DIQ3^ABMER31A

 +4                SET ABME("ESTATE")=$GET(ABM(9999999.75,+DA,.04,"I"))

               End DoDot:1

 +5        IF '$GET(ABME("ESTATE"))

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +6                    SET ABME("FLD")=.04

 +7                    DO DIQ2^ABMER31A

 +8                    SET ABME("ESTATE")=$GET(ABM(9999999.75,+ABME("EMP"),.04,"I"))

                   End DoDot:1

 +9        SET ABMR(32,160)=$SELECT($GET(ABME("ESTATE")):$PIECE($GET(^DIC(5,ABME("ESTATE"),0)),"^",2),1:"")

 +10       SET ABMR(32,160)=$$FMT^ABMERUTL(ABMR(32,160),2)

 +11       QUIT 

 +12      ;

170       ;255-263 Employer Zip

 +1        SET ABMR(32,170)=""

 +2        IF $GET(ABME("PPP"))

               Begin DoDot:1

 +3                SET ABME("FLD")=.05

 +4                DO DIQ3^ABMER31A

 +5                SET ABMR(32,170)=$GET(ABM(9999999.75,+DA,.05,"E"))

               End DoDot:1

 +6        IF ABMR(32,170)=""

               IF $GET(ABME("PH"))

                   Begin DoDot:1

 +7                    SET ABME("FLD")=.05

 +8                    DO DIQ2^ABMER31A

 +9                    SET ABMR(32,170)=$GET(ABM(9999999.75,+ABME("EMP"),.05,"E"))

                   End DoDot:1

 +10       SET ABMR(32,170)=$$FMT^ABMERUTL(ABMR(32,170),9)

 +11       QUIT 

 +12      ;

180       ;264-275 Employee ID #

 +1        SET ABMR(32,180)=""

 +2        SET ABMR(32,180)=$$FMT^ABMERUTL(ABMR(32,180),12)

 +3        QUIT 

 +4       ;

190       ;276-300 Filler (National)

 +1        SET ABMR(32,190)=""

 +2        SET ABMR(32,190)=$$FMT^ABMERUTL(ABMR(32,190),25)

 +3        QUIT 

200       ;301-320 Filler (Local)

 +1        SET ABMR(32,200)=""

 +2        SET ABMR(32,200)=$$FMT^ABMERUTL(ABMR(32,200),20)

 +3        QUIT 

 +4       ;

EX(ABMX,ABMY,ABMZ) ;EXTRINSIC FUNCTION HERE

 +1       ;

 +2       ;  INPUT:  ABMX = data element

 +3       ;          ABMY = bill internal entry number

 +4       ;          ABMZ = Insurer priority (1 thru 3)

 +5       ;

 +6       ; OUTPUT:     Y = bill internal entry number

 +7       ;

 +8        SET ABMP("BDFN")=ABMY

 +9        DO SET^ABMERUTL

 +10       SET ABME("INS")=ABMZ

 +11       IF '$DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABME("INS")))

               SET Y=""

               QUIT Y

 +12       DO ISET^ABMERINS

 +13       IF '$GET(ABMP("NOFMT"))

               SET ABMP("FMT")=0

 +14       DO @ABMX

 +15       SET Y=ABMR(32,ABMX)

 +16       IF $DATA(ABMP("FMT"))

               SET ABMP("FMT")=1

 +17       KILL ABMR(32,ABMX),ABME,ABMX,ABMY,ABMZ,ABM

 +18       QUIT Y