ABME5DMG.m

ABME5DMG ; IHS/ASDST/DMJ - 837 DMG Segment 

 ;;2.6;IHS Third Party Billing System;**6**;NOV 12, 2009;Build 379

 ;Demographic Information

EP(X,Y) ;EP

 ;x=file

 ;y=ien

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

 S ABME("RTYPE")="DMG"

 S ABMFILE=X

 S ABMFIEN=Y

 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(ABMFIEN,0),"^",2)

 I ABMFILE=9000003.1 D

 .S ABMR("DMG",40)=$P(^AUPN3PPH(ABMFIEN,0),"^",8)

 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

110 ;DMG10 - Code List Qualifier Code

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

 Q

120 ;DMG11 - Industry Code

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

 Q

ABME5DMG  ; IHS/ASDST/DMJ - 837 DMG Segment 

 +1       ;;2.6;IHS Third Party Billing System;**6**;NOV 12, 2009;Build 379

 +2       ;Demographic Information

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        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                SET ABMR("DMG",40)=$PIECE(^DPT(ABMFIEN,0),"^",2)

               End DoDot:1

 +4        IF ABMFILE=9000003.1

               Begin DoDot:1

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

               End DoDot:1

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

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

 +7        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 

110       ;DMG10 - Code List Qualifier Code

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

 +2        QUIT 

120       ;DMG11 - Industry Code

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

 +2        QUIT