ABME8CR1.m

ABME8CR1 ; IHS/SD/SDR - 837 CR1 Segment 

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

 ;Transaction Set Header

 ;

EP ;EP - START HERE

 K ABMREC("CR1"),ABMR("CR1")

 S ABME("RTYPE")="CR1"

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:110 D

 .D @I

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

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

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

 Q

10 ;segment

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

 Q

20 ;CR101 - Unit or Basis for Measurement Code

 S ABMR("CR1",20)=$S($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,11)'="":"LB",1:"")

 Q

30 ;CR102 - Weight

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

 S ABMR("CR1",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,11)

 Q

40 ;CR103 - Ambulance Transport Code

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

 S ABMR("CR1",40)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,12)

 Q

50 ;CR104 - Ambualnce Transport Reason Code

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

 S ABMR("CR1",50)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,13)

 Q

60 ;CR105 - Unit or Basis for Measurement Code

 S ABMR("CR1",60)="DH"

 Q

70 ;CR106 - Quantity

 S ABMR("CR1",70)=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,8)

 Q

80 ;CR107 - Address Information (not used)

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

 Q

90 ;CR108 - Address Information (not used)

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

 Q

100 ;CR109 - Description

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

 Q

110 ;CR110 - Description

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

 Q

ABME8CR1  ; IHS/SD/SDR - 837 CR1 Segment 

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

 +2       ;Transaction Set Header

 +3       ;

EP        ;EP - START HERE

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

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

 +3        DO LOOP

 +4        KILL ABME,ABM

 +5        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:110

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

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;CR101 - Unit or Basis for Measurement Code

 +1        SET ABMR("CR1",20)=$SELECT($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,11)'="":"LB",1:"")

 +2        QUIT 

30        ;CR102 - Weight

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

 +2        SET ABMR("CR1",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,11)

 +3        QUIT 

40        ;CR103 - Ambulance Transport Code

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

 +2        SET ABMR("CR1",40)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,12)

 +3        QUIT 

50        ;CR104 - Ambualnce Transport Reason Code

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

 +2        SET ABMR("CR1",50)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,13)

 +3        QUIT 

60        ;CR105 - Unit or Basis for Measurement Code

 +1        SET ABMR("CR1",60)="DH"

 +2        QUIT 

70        ;CR106 - Quantity

 +1        SET ABMR("CR1",70)=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),12)),U,8)

 +2        QUIT 

80        ;CR107 - Address Information (not used)

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

 +2        QUIT 

90        ;CR108 - Address Information (not used)

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

 +2        QUIT 

100       ;CR109 - Description

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

 +2        QUIT 

110       ;CR110 - Description

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

 +2        QUIT