ABME5PAT.m

ABME5PAT ; IHS/ASDST/DMJ - 837 PAT Segment 

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

 ;Patient Information

 ;  

START ;START HERE

 K ABMREC("PAT"),ABMR("PAT")

 S ABME("RTYPE")="PAT"

 D LOOP

 K ABME,ABM

 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("PAT"))'="" S ABMREC("PAT")=ABMREC("PAT")_"*"

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

 Q

10 ;segment

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

 Q

20 ;PAT01 - Individual Relationship Code

 S ABMR("PAT",20)=$$REL^ABMUTLP(ABMP("BDFN"))

 Q

30 ;PAT02 - Patient Location Code

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

 Q

40 ;PAT03 - Employment Status Code

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

 Q

50 ;PAT04 - Student Status Code

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

 Q

60 ;PAT05 - Date Time Period Format Qualifier

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

 Q

70 ;PAT06 - Date Time Period

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

 Q

80 ;PAT07 - Unit or Basis for Measurement Code

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

 S:$P($G(^ABMDBILL(DUZ(2),+ABMB0,12)),U,11) ABMR("PAT",80)="01" ;5010 837P

 Q

90 ;PAT08 - Weight

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

 S:$P($G(^ABMDBILL(DUZ(2),+ABMB0,12)),U,11) ABMR("PAT",90)=$P($G(^ABMDBILL(DUZ(2),+ABMB0,12)),U,11) ;5010 837P

 Q

100 ;PAT09 - Pregnancy Indicator

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

 Q

ABME5PAT  ; IHS/ASDST/DMJ - 837 PAT Segment 

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

 +2       ;Patient Information

 +3       ;  

START     ;START HERE

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

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

 +3        DO LOOP

 +4        KILL ABME,ABM

 +5        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("PAT"))'=""

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;PAT01 - Individual Relationship Code

 +1        SET ABMR("PAT",20)=$$REL^ABMUTLP(ABMP("BDFN"))

 +2        QUIT 

30        ;PAT02 - Patient Location Code

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

 +2        QUIT 

40        ;PAT03 - Employment Status Code

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

 +2        QUIT 

50        ;PAT04 - Student Status Code

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

 +2        QUIT 

60        ;PAT05 - Date Time Period Format Qualifier

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

 +2        QUIT 

70        ;PAT06 - Date Time Period

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

 +2        QUIT 

80        ;PAT07 - Unit or Basis for Measurement Code

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

 +2       ;5010 837P

           IF $PIECE($GET(^ABMDBILL(DUZ(2),+ABMB0,12)),U,11)

               SET ABMR("PAT",80)="01"

 +3        QUIT 

90        ;PAT08 - Weight

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

 +2       ;5010 837P

           IF $PIECE($GET(^ABMDBILL(DUZ(2),+ABMB0,12)),U,11)

               SET ABMR("PAT",90)=$PIECE($GET(^ABMDBILL(DUZ(2),+ABMB0,12)),U,11)

 +3        QUIT 

100       ;PAT09 - Pregnancy Indicator

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

 +2        QUIT