ABME5MEA.m

ABME5MEA ; IHS/SD/SDR - 837 MEA Segment 

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

 ;

EP ;EP - START HERE

 K ABMREC("MEA"),ABMR("MEA")

 S ABME("RTYPE")="MEA"

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:130 D

 .D @I

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

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

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

 Q

10 ;segment

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

 Q

20 ;MEA01 - Measurement Reference ID code

 S ABMR("MEA",20)="TR"

 Q

30 ;MEA02 - Measurement Qualifier

 S ABMR("MEA",30)=""

 S ABMR("MEA",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,ABMJ,0)),U,19)

 Q

40 ;MEA03 - Measurement Value

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

 S ABMR("MEA",40)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,ABMJ,0)),U,21)

50 ;MEA04 - Composite unit of measure

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

60 ;MEA05 - Range Minimum

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

70 ;MEA06 - Range Maximum

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

80 ;MEA07 - Measurement Significance Code

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

90 ;MEA08 - Measurement Attribute Code

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

100 ;MEA09 - Surface/Layer/Position Code

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

110 ;MEA10 - Measurement Method or Device

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

120 ;MEA11 - Code List Qualifier Code

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

130 ;MEA12 - Industry Code

 S ABMR("MEA",130)=""

 Q

ABME5MEA  ; IHS/SD/SDR - 837 MEA Segment 

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

 +2       ;

EP        ;EP - START HERE

 +1        KILL ABMREC("MEA"),ABMR("MEA")

 +2        SET ABME("RTYPE")="MEA"

 +3        DO LOOP

 +4        KILL ABME,ABM

 +5        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:130

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

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;MEA01 - Measurement Reference ID code

 +1        SET ABMR("MEA",20)="TR"

 +2        QUIT 

30        ;MEA02 - Measurement Qualifier

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

 +2        SET ABMR("MEA",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,ABMJ,0)),U,19)

 +3        QUIT 

40        ;MEA03 - Measurement Value

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

 +2        SET ABMR("MEA",40)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),37,ABMJ,0)),U,21)

50        ;MEA04 - Composite unit of measure

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

60        ;MEA05 - Range Minimum

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

70        ;MEA06 - Range Maximum

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

80        ;MEA07 - Measurement Significance Code

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

90        ;MEA08 - Measurement Attribute Code

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

100       ;MEA09 - Surface/Layer/Position Code

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

110       ;MEA10 - Measurement Method or Device

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

120       ;MEA11 - Code List Qualifier Code

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

130       ;MEA12 - Industry Code

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

 +2        QUIT