ABME5GS.m

ABME5GS ; IHS/ASDST/DMJ - 837 GS Segment 

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

 ;Functional Group Header

 ;

START ;START HERE

 K ABMREC("GS"),ABMR("GS")

 S ABME("RTYPE")="GS"

 S ABMSTCNT=1 ;5010 837P

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:90 D

 .D @I

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

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

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

 I '$D(^ABMEXLM("AA",+$G(ABMP("INS")),+$G(ABMP("EXP")),ABME("RTYPE"),I)) D 837^ABMUTL8

 Q

10 ;segment

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

 Q

20 ;GS01 - Functional Identifier Code

 S ABMR("GS",20)="HC"

 Q

30 ;GS02 - Application Sender's Code

 S ABMR("GS",30)=$$SNDR^ABMUTLP(ABMP("INS"),ABMP("VTYP"))

 Q

40 ;GS03 - Application Receiver's Code

 S ABMR("GS",40)=$$RCID^ABMUTLP(ABMP("INS"))

 Q

50 ;GS04 - Date

 S ABMR("GS",50)=$$Y2KD2^ABMDUTL(DT)

 Q

60 ;GS05 - Time

 D NOW^%DTC

 S ABMR("GS",60)=$P(%,".",2)

 S ABMR("GS",60)=$$FMT^ABMERUTL(ABMR("GS",60),"4N")

 Q

70 ;GS06 - Group Control Number

 S ABMR("GS",70)=$$TCN^ABMERUTL(ABMPXMIT)

 Q

80 ;GS07 - Responsible Agency Code

 S ABMR("GS",80)="X"

 Q

90 ;GS08 - Version/Release/Industry Identifier Code

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

 S:ABMP("EXP")=32 ABMR("GS",90)="005010X222A1"

 S:ABMP("EXP")=31 ABMR("GS",90)="005010X223A2"

 S:ABMP("EXP")=33 ABMR("GS",90)="005010X224A2"

 Q

ABME5GS   ; IHS/ASDST/DMJ - 837 GS Segment 

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

 +2       ;Functional Group Header

 +3       ;

START     ;START HERE

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

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

 +3       ;5010 837P

           SET ABMSTCNT=1

 +4        DO LOOP

 +5        KILL ABME,ABM

 +6        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:90

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

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

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

               End DoDot:1

 +6        IF '$DATA(^ABMEXLM("AA",+$GET(ABMP("INS")),+$GET(ABMP("EXP")),ABME("RTYPE"),I))

               DO 837^ABMUTL8

 +7        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;GS01 - Functional Identifier Code

 +1        SET ABMR("GS",20)="HC"

 +2        QUIT 

30        ;GS02 - Application Sender's Code

 +1        SET ABMR("GS",30)=$$SNDR^ABMUTLP(ABMP("INS"),ABMP("VTYP"))

 +2        QUIT 

40        ;GS03 - Application Receiver's Code

 +1        SET ABMR("GS",40)=$$RCID^ABMUTLP(ABMP("INS"))

 +2        QUIT 

50        ;GS04 - Date

 +1        SET ABMR("GS",50)=$$Y2KD2^ABMDUTL(DT)

 +2        QUIT 

60        ;GS05 - Time

 +1        DO NOW^%DTC

 +2        SET ABMR("GS",60)=$PIECE(%,".",2)

 +3        SET ABMR("GS",60)=$$FMT^ABMERUTL(ABMR("GS",60),"4N")

 +4        QUIT 

70        ;GS06 - Group Control Number

 +1        SET ABMR("GS",70)=$$TCN^ABMERUTL(ABMPXMIT)

 +2        QUIT 

80        ;GS07 - Responsible Agency Code

 +1        SET ABMR("GS",80)="X"

 +2        QUIT 

90        ;GS08 - Version/Release/Industry Identifier Code

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

 +2        IF ABMP("EXP")=32

               SET ABMR("GS",90)="005010X222A1"

 +3        IF ABMP("EXP")=31

               SET ABMR("GS",90)="005010X223A2"

 +4        IF ABMP("EXP")=33

               SET ABMR("GS",90)="005010X224A2"

 +5        QUIT