ABME8DMG.m

ABME8DMG ; IHS/ASDST/DMJ - 837 DMG Segment 

 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009

 ;Demographic Information

 ;

 ; IHS/SD/SDR - v2.5 p8 - IM13177/IM13285

 ;    Modified DOB to pull what's on file for subscriber of said

 ;    insurer before using what's on file for patient

 ;

 ; IHS/SD/SDR - v2.5 p9 - IM19664 - Correction to DOB in patch 8

 ; IHS/SD/SDR - abm*2.6*1 - HEAT7074 - <UNDEF>40+5^ABME8DMG

 ;

EP(X,Y) ;EP

 ;x=file

 ;y=ien

 K ABMREC("DMG"),ABMR("DMG")

 S ABME("RTYPE")="DMG"

 S ABMFILE=X

 S ABMFIEN=Y  ;abm*2.6*1 HEAT7074

 S:X=3 ABMFILE=9000003.1

 D LOOP

 K ABME,ABM,ABMFILE

 Q

LOOP ;LOOP HERE

 F I=10:10:100 D

 .D @I

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

 .I $G(ABMREC("DMG"))'="" S ABMREC("DMG")=ABMREC("DMG")_"*"

 .S ABMREC("DMG")=$G(ABMREC("DMG"))_ABMR("DMG",I)

 Q

10 ;segment

 S ABMR("DMG",10)="DMG"

 Q

20 ;DMG01 - Date Time Period Format Qualifier

 S ABMR("DMG",20)="D8"

 Q

30 ;DMG02 - Date of Birth

 N ABMTMPT,ABMTMPI,ABMTMPHI

 S ABMDOB=0

 S ABMTMPT=$P(ABMP("INS",ABMI),U,2)  ;ins type

 ; if Medicaid or Kidscare, get Medicaid DOB

 I ABMTMPT="K"!(ABMTMPT="D") D

 .S ABMTMPI=$P(ABMP("INS",ABMI),U,6)  ;ien to MCD Elig.

 .Q:'+ABMTMPI

 .S ABMDOB=$P($G(^AUPNMCD(ABMTMPI,21)),U,2)

 ; else if Medicare, get Medicare DOB

 E  I ABMTMPT="R" S ABMDOB=$P($G(^AUPNMCR(ABMP("PDFN"),21)),U,2)

 ; else must be private, get Policy Holder DOB

 E  D

 .S ABMTMPI=$P(ABMP("INS",ABMI),U,8)  ;IEN ins mult of prvt elig

 .Q:'+ABMTMPI

 .S ABMTMPHI=$P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMTMPI,0)),U,8)

 .Q:'+ABMTMPHI

 .S:ABMCHILD ABMDOB=$P($G(^AUPN3PPH(ABMTMPHI,0)),U,19)

 ;if no DOB for subscriber, pull patient's DOB

 I '+ABMDOB S ABMDOB=$P($G(^DPT(ABMP("PDFN"),0)),U,3)

 I +ABMDOB S ABMR("DMG",30)=$$Y2KD2^ABMDUTL(ABMDOB)

 Q

40 ;DMG03 - Gender Code

 S ABMR("DMG",40)=""

 I ABMFILE=2 D

 .;S ABMR("DMG",40)=$P(^DPT(Y,0),"^",2)  ;abm*2.6*1 HEAT7074

 .S ABMR("DMG",40)=$P(^DPT(ABMFIEN,0),"^",2)  ;abm*2.6*1 HEAT7074

 I ABMFILE=9000003.1 D

 .;S ABMR("DMG",40)=$P(^AUPN3PPH(Y,0),"^",8)  ;abm*2.6*1 HEAT7074

 .S ABMR("DMG",40)=$P(^AUPN3PPH(ABMFIEN,0),"^",8)  ;abm*2.6*1 HEAT7074

 S:ABMR("DMG",40)="" ABMR("DMG",40)="U"

 Q

50 ;DMG04 - Marital Status Code

 S ABMR("DMG",50)=""

 Q

60 ;DMG05 - Race or Ethnicity Code

 S ABMR("DMG",60)=""

 Q

70 ;DMG06 - Citizenship Status Code

 S ABMR("DMG",70)=""

 Q

80 ;DMG07 - Country Code

 S ABMR("DMG",80)=""

 Q

90 ;DMG08 - Basis of Verification Code

 S ABMR("DMG",90)=""

 Q

100 ;DMG09 - Quantity

 S ABMR("DMG",100)=""

 Q

ABME8DMG  ; IHS/ASDST/DMJ - 837 DMG Segment 

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

 +2       ;Demographic Information

 +3       ;

 +4       ; IHS/SD/SDR - v2.5 p8 - IM13177/IM13285

 +5       ;    Modified DOB to pull what's on file for subscriber of said

 +6       ;    insurer before using what's on file for patient

 +7       ;

 +8       ; IHS/SD/SDR - v2.5 p9 - IM19664 - Correction to DOB in patch 8

 +9       ; IHS/SD/SDR - abm*2.6*1 - HEAT7074 - <UNDEF>40+5^ABME8DMG

 +10      ;

EP(X,Y)   ;EP

 +1       ;x=file

 +2       ;y=ien

 +3        KILL ABMREC("DMG"),ABMR("DMG")

 +4        SET ABME("RTYPE")="DMG"

 +5        SET ABMFILE=X

 +6       ;abm*2.6*1 HEAT7074

           SET ABMFIEN=Y

 +7        IF X=3

               SET ABMFILE=9000003.1

 +8        DO LOOP

 +9        KILL ABME,ABM,ABMFILE

 +10       QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:100

               Begin DoDot:1

 +2                DO @I

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

                       DO @(^(I))

 +4                IF $GET(ABMREC("DMG"))'=""

                       SET ABMREC("DMG")=ABMREC("DMG")_"*"

 +5                SET ABMREC("DMG")=$GET(ABMREC("DMG"))_ABMR("DMG",I)

               End DoDot:1

 +6        QUIT 

10        ;segment

 +1        SET ABMR("DMG",10)="DMG"

 +2        QUIT 

20        ;DMG01 - Date Time Period Format Qualifier

 +1        SET ABMR("DMG",20)="D8"

 +2        QUIT 

30        ;DMG02 - Date of Birth

 +1        NEW ABMTMPT,ABMTMPI,ABMTMPHI

 +2        SET ABMDOB=0

 +3       ;ins type

           SET ABMTMPT=$PIECE(ABMP("INS",ABMI),U,2)

 +4       ; if Medicaid or Kidscare, get Medicaid DOB

 +5        IF ABMTMPT="K"!(ABMTMPT="D")

               Begin DoDot:1

 +6       ;ien to MCD Elig.

                   SET ABMTMPI=$PIECE(ABMP("INS",ABMI),U,6)

 +7                IF '+ABMTMPI

                       QUIT 

 +8                SET ABMDOB=$PIECE($GET(^AUPNMCD(ABMTMPI,21)),U,2)

               End DoDot:1

 +9       ; else if Medicare, get Medicare DOB

 +10      IF '$TEST

               IF ABMTMPT="R"

                   SET ABMDOB=$PIECE($GET(^AUPNMCR(ABMP("PDFN"),21)),U,2)

 +11      ; else must be private, get Policy Holder DOB

 +12      IF '$TEST

               Begin DoDot:1

 +13      ;IEN ins mult of prvt elig

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

 +14               IF '+ABMTMPI

                       QUIT 

 +15               SET ABMTMPHI=$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMTMPI,0)),U,8)

 +16               IF '+ABMTMPHI

                       QUIT 

 +17               IF ABMCHILD

                       SET ABMDOB=$PIECE($GET(^AUPN3PPH(ABMTMPHI,0)),U,19)

               End DoDot:1

 +18      ;if no DOB for subscriber, pull patient's DOB

 +19       IF '+ABMDOB

               SET ABMDOB=$PIECE($GET(^DPT(ABMP("PDFN"),0)),U,3)

 +20       IF +ABMDOB

               SET ABMR("DMG",30)=$$Y2KD2^ABMDUTL(ABMDOB)

 +21       QUIT 

40        ;DMG03 - Gender Code

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

 +2        IF ABMFILE=2

               Begin DoDot:1

 +3       ;S ABMR("DMG",40)=$P(^DPT(Y,0),"^",2)  ;abm*2.6*1 HEAT7074

 +4       ;abm*2.6*1 HEAT7074

                   SET ABMR("DMG",40)=$PIECE(^DPT(ABMFIEN,0),"^",2)

               End DoDot:1

 +5        IF ABMFILE=9000003.1

               Begin DoDot:1

 +6       ;S ABMR("DMG",40)=$P(^AUPN3PPH(Y,0),"^",8)  ;abm*2.6*1 HEAT7074

 +7       ;abm*2.6*1 HEAT7074

                   SET ABMR("DMG",40)=$PIECE(^AUPN3PPH(ABMFIEN,0),"^",8)

               End DoDot:1

 +8        IF ABMR("DMG",40)=""

               SET ABMR("DMG",40)="U"

 +9        QUIT 

50        ;DMG04 - Marital Status Code

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

 +2        QUIT 

60        ;DMG05 - Race or Ethnicity Code

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

 +2        QUIT 

70        ;DMG06 - Citizenship Status Code

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

 +2        QUIT 

80        ;DMG07 - Country Code

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

 +2        QUIT 

90        ;DMG08 - Basis of Verification Code

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

 +2        QUIT 

100       ;DMG09 - Quantity

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

 +2        QUIT