ABME8ISA.m

ABME8ISA ; IHS/ASDST/DMJ - 837 ISA Segment 

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

 ;Interchange Control Header

 ;

START ;START HERE

 K ABMREC("ISA"),ABMR("ISA")

 S ABME("RTYPE")="ISA"

 D LOOP

 K ABME,ABM

 Q

LOOP ;LOOP HERE

 F I=10:10:170 D

 .D @I

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

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

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

 Q

10 ;segment

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

 Q

20 ;ISA01 - Authorization Information Qualifier

 S ABMR("ISA",20)="00"

 Q

30 ;ISA02 - Authorization Information

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

 S ABMR("ISA",30)=$$FMT^ABMERUTL(ABMR("ISA",30),10)

 Q

40 ;ISA03 - Security Information Qualifier

 S ABMR("ISA",40)="00"

 I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",3)'="" D

 .S ABMR("ISA",40)="01"

 Q

50 ;ISA04 - Security Information

 S ABMR("ISA",50)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",3)

 S ABMR("ISA",50)=$$FMT^ABMERUTL(ABMR("ISA",50),10)

 Q

60 ;ISA05 - Interchange ID Qualifier

 S ABMR("ISA",60)="ZZ"

 Q

70 ;ISA06 - Interchange Sender ID

 S ABMR("ISA",70)=$$SNDR^ABMUTLP(ABMP("INS"),ABMP("VTYP"))

 S ABMR("ISA",70)=$$FMT^ABMERUTL(ABMR("ISA",70),15)

 Q

80 ;ISA07 - Interchange ID Qualifier

 S ABMR("ISA",80)="ZZ"

 S:$$RCID^ABMUTLP(ABMP("INS"))="C00900" ABMR("ISA",80)=27

 S:$$RCID^ABMUTLP(ABMP("INS"))="04402" ABMR("ISA",80)=27

 S:$G(ABMPITYP)="P" ABMR("ISA",80)=33

 ;start new code abm*2.6*8

 I $D(^ABMRECVR("C",ABMP("INS"))) D

 .S ABMCHIEN=$O(^ABMRECVR("C",ABMP("INS"),0))

 .S:ABMCHIEN ABMR("ISA",80)=$P($G(^ABMRECVR(ABMCHIEN,0)),U,5)

 ;end new code

 Q

90 ;ISA08 - Interchange Receiver ID

 S ABMR("ISA",90)=$$RCID^ABMUTLP(ABMP("INS"))

 S ABMR("ISA",90)=$$FMT^ABMERUTL(ABMR("ISA",90),15)

 Q

100 ;ISA09 - Interchange Date

 S ABMR("ISA",100)=$E($$Y2KD2^ABMDUTL(DT),3,8)

 Q

110 ;ISA10 - Interchange Time

 D NOW^%DTC

 S ABMR("ISA",110)=$P(%,".",2)

 S ABMR("ISA",110)=$$FMT^ABMERUTL(ABMR("ISA",110),"4N")

 Q

120 ;ISA11 - Interchange Control Standards Identifier

 S ABMR("ISA",120)="U"

 Q

130 ;ISA12 - Interchange Control Version Number

 S ABMR("ISA",130)="00401"

 Q

140 ;ISA13 - Interchange Control Number

 S ABMR("ISA",140)=$$TCN^ABMERUTL(ABMPXMIT)

 S ABMR("ISA",140)=$$FMT^ABMERUTL(ABMR("ISA",140),"9NR")

 Q

150 ;ISA14 - Acknowledgement Requested

 S ABMR("ISA",150)=1

 Q

160 ;ISA15 - Usage Indicator

 S ABMR("ISA",160)=$P($G(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",4)

 S:ABMR("ISA",160)="" ABMR("ISA",160)="P"

 Q

170 ;ISA16 - Component Element Separator

 S ABMR("ISA",170)=":"

 Q

ABME8ISA  ; IHS/ASDST/DMJ - 837 ISA Segment 

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

 +2       ;Interchange Control Header

 +3       ;

START     ;START HERE

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

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

 +3        DO LOOP

 +4        KILL ABME,ABM

 +5        QUIT 

LOOP      ;LOOP HERE

 +1        FOR I=10:10:170

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

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;ISA01 - Authorization Information Qualifier

 +1        SET ABMR("ISA",20)="00"

 +2        QUIT 

30        ;ISA02 - Authorization Information

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

 +2        SET ABMR("ISA",30)=$$FMT^ABMERUTL(ABMR("ISA",30),10)

 +3        QUIT 

40        ;ISA03 - Security Information Qualifier

 +1        SET ABMR("ISA",40)="00"

 +2        IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",3)'=""

               Begin DoDot:1

 +3                SET ABMR("ISA",40)="01"

               End DoDot:1

 +4        QUIT 

50        ;ISA04 - Security Information

 +1        SET ABMR("ISA",50)=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",3)

 +2        SET ABMR("ISA",50)=$$FMT^ABMERUTL(ABMR("ISA",50),10)

 +3        QUIT 

60        ;ISA05 - Interchange ID Qualifier

 +1        SET ABMR("ISA",60)="ZZ"

 +2        QUIT 

70        ;ISA06 - Interchange Sender ID

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

 +2        SET ABMR("ISA",70)=$$FMT^ABMERUTL(ABMR("ISA",70),15)

 +3        QUIT 

80        ;ISA07 - Interchange ID Qualifier

 +1        SET ABMR("ISA",80)="ZZ"

 +2        IF $$RCID^ABMUTLP(ABMP("INS"))="C00900"

               SET ABMR("ISA",80)=27

 +3        IF $$RCID^ABMUTLP(ABMP("INS"))="04402"

               SET ABMR("ISA",80)=27

 +4        IF $GET(ABMPITYP)="P"

               SET ABMR("ISA",80)=33

 +5       ;start new code abm*2.6*8

 +6        IF $DATA(^ABMRECVR("C",ABMP("INS")))

               Begin DoDot:1

 +7                SET ABMCHIEN=$ORDER(^ABMRECVR("C",ABMP("INS"),0))

 +8                IF ABMCHIEN

                       SET ABMR("ISA",80)=$PIECE($GET(^ABMRECVR(ABMCHIEN,0)),U,5)

               End DoDot:1

 +9       ;end new code

 +10       QUIT 

90        ;ISA08 - Interchange Receiver ID

 +1        SET ABMR("ISA",90)=$$RCID^ABMUTLP(ABMP("INS"))

 +2        SET ABMR("ISA",90)=$$FMT^ABMERUTL(ABMR("ISA",90),15)

 +3        QUIT 

100       ;ISA09 - Interchange Date

 +1        SET ABMR("ISA",100)=$EXTRACT($$Y2KD2^ABMDUTL(DT),3,8)

 +2        QUIT 

110       ;ISA10 - Interchange Time

 +1        DO NOW^%DTC

 +2        SET ABMR("ISA",110)=$PIECE(%,".",2)

 +3        SET ABMR("ISA",110)=$$FMT^ABMERUTL(ABMR("ISA",110),"4N")

 +4        QUIT 

120       ;ISA11 - Interchange Control Standards Identifier

 +1        SET ABMR("ISA",120)="U"

 +2        QUIT 

130       ;ISA12 - Interchange Control Version Number

 +1        SET ABMR("ISA",130)="00401"

 +2        QUIT 

140       ;ISA13 - Interchange Control Number

 +1        SET ABMR("ISA",140)=$$TCN^ABMERUTL(ABMPXMIT)

 +2        SET ABMR("ISA",140)=$$FMT^ABMERUTL(ABMR("ISA",140),"9NR")

 +3        QUIT 

150       ;ISA14 - Acknowledgement Requested

 +1        SET ABMR("ISA",150)=1

 +2        QUIT 

160       ;ISA15 - Usage Indicator

 +1        SET ABMR("ISA",160)=$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),0)),"^",4)

 +2        IF ABMR("ISA",160)=""

               SET ABMR("ISA",160)="P"

 +3        QUIT 

170       ;ISA16 - Component Element Separator

 +1        SET ABMR("ISA",170)=":"

 +2        QUIT