ABME8NM2.m

ABME8NM2 ; IHS/ASDST/DMJ - 837 NM1 Segment 

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

 ;other payer patient

 ;

EP(X,Y) ;EP - START HERE

 ;x=entity identifier

 ;y=file ien (optional)

 S ABMEIC=X

 S ABMIEN=$G(Y)

 K ABMREC("NM1"),ABMR("NM1")

 S ABME("RTYPE")="NM1"

 D LOOP

 K ABME,ABMEIC

 Q

 ;

LOOP ;LOOP HERE

 F I=10:10:120 D

 .D @I

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

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

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

 Q

 ;

10 ;segment

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

 Q

 ;

20 ;NM101 - Entity Identifier Code

 S ABMR("NM1",20)=ABMEIC

 Q

 ;

30 ;NM102 - Entity Type Qualifier

 S ABMR("NM1",30)=1

 Q

 ;

40 ;NM103 - Name Last or Organization Name

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

 Q

 ;

50 ;NM104 - Name First

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

 Q

 ;

60 ;NM105 - Name Middle

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

 Q

 ;

70 ;NM106 - Name Prefix (Not used)

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

 Q

 ;

80 ;NM107 - Name Suffix

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

 Q

 ;

90 ;NM108 - Identification Code Qualifier

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

 I ABMEIC="QC" D

 .S ABMR("NM1",90)="MI"

 Q

 ;

100 ;NM109 - Identification Code

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

 I ABMEIC="QC" D

 .S ABMR("NM1",100)=$G(ABMP("PNUM",ABMIEN))

 .S:'ABMIEN ABMR("NM1",100)=$G(ABMP("PNUM"))

 Q

 ;

110 ;NM110 - Entity Relationship Code (Not used)

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

 Q

 ;

120 ;NM111 - Entity Identifier Code (Not used)

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

 Q

ABME8NM2  ; IHS/ASDST/DMJ - 837 NM1 Segment 

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

 +2       ;other payer patient

 +3       ;

EP(X,Y)   ;EP - START HERE

 +1       ;x=entity identifier

 +2       ;y=file ien (optional)

 +3        SET ABMEIC=X

 +4        SET ABMIEN=$GET(Y)

 +5        KILL ABMREC("NM1"),ABMR("NM1")

 +6        SET ABME("RTYPE")="NM1"

 +7        DO LOOP

 +8        KILL ABME,ABMEIC

 +9        QUIT 

 +10      ;

LOOP      ;LOOP HERE

 +1        FOR I=10:10:120

               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("NM1"))'=""

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

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

               End DoDot:1

 +6        QUIT 

 +7       ;

10        ;segment

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

 +2        QUIT 

 +3       ;

20        ;NM101 - Entity Identifier Code

 +1        SET ABMR("NM1",20)=ABMEIC

 +2        QUIT 

 +3       ;

30        ;NM102 - Entity Type Qualifier

 +1        SET ABMR("NM1",30)=1

 +2        QUIT 

 +3       ;

40        ;NM103 - Name Last or Organization Name

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

 +2        QUIT 

 +3       ;

50        ;NM104 - Name First

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

 +2        QUIT 

 +3       ;

60        ;NM105 - Name Middle

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

 +2        QUIT 

 +3       ;

70        ;NM106 - Name Prefix (Not used)

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

 +2        QUIT 

 +3       ;

80        ;NM107 - Name Suffix

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

 +2        QUIT 

 +3       ;

90        ;NM108 - Identification Code Qualifier

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

 +2        IF ABMEIC="QC"

               Begin DoDot:1

 +3                SET ABMR("NM1",90)="MI"

               End DoDot:1

 +4        QUIT 

 +5       ;

100       ;NM109 - Identification Code

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

 +2        IF ABMEIC="QC"

               Begin DoDot:1

 +3                SET ABMR("NM1",100)=$GET(ABMP("PNUM",ABMIEN))

 +4                IF 'ABMIEN

                       SET ABMR("NM1",100)=$GET(ABMP("PNUM"))

               End DoDot:1

 +5        QUIT 

 +6       ;

110       ;NM110 - Entity Relationship Code (Not used)

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

 +2        QUIT 

 +3       ;

120       ;NM111 - Entity Identifier Code (Not used)

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

 +2        QUIT