ABME5PWK.m

ABME5PWK ; IHS/ASDST/DMJ - 837 PWK Segment 

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

 ;Transaction Set Header

 ;  

START ;START HERE

 K ABMREC("PWK"),ABMR("PWK")

 S ABME("RTYPE")="PWK"

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

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

 Q

10 ;segment

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

 Q

20 ;PWK01 - Report Type Code

 S ABMR("PWK",20)=$P($G(^ABMDCODE($P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U),0)),U)  ;abm*2.6*1 HEAT6439 ;5010 837p  ;abm*2.6*8

 ;S ABMR("PWK",20)="EB" ;5010 837P  ;abm*2.6*8

 Q

30 ;PWK02 - Report Transmission Code

 S ABMR("PWK",30)="" ;5010 837P  ;abm*2.6*8

 S ABMR("PWK",30)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U,2)  ;abm*2.6*1 HEAT6439 ;5010 837p  ;abm*2.6*8

 ;S ABMR("PWK",30)="FT" ;5010 837P  ;abm*2.6*8

 Q

40 ;PWK03 - Report Copies Needed-not used

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

 Q

50 ;PWK04 - Entity Identifier Code-not used

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

 Q

60 ;PWK05 - Identification Code Qualifier

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

 S ABMR("PWK",60)="AC"  ;abm*2.6*1 HEAT6439  ;abm*2.6*2 ;5010 837p  ;abm*2.6*8

 S ABMR("PWK",30)="FT" ;5010 837P  ;abm*2.6*8

 I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U,3)'="" S ABMR("PWK",60)="AC"  ;abm*2.6*2 ;5010 837p  ;abm*2.6*8

 ;S ABMR("PWK",30)="FT" ;5010 837P

 Q

70 ;PWK06 - Identification Code

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

 S ABMR("PWK",70)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U,3)  ;abm*2.6*1 HEAT6439 ;5010 837P  ;abm*2.6*8

 Q

80 ;PWK07 - Description

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

 Q

90 ;PWK08 - Actions Indicated-not used

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

 Q

100 ;PWK09 - Request Category Code-not used

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

 Q

ABME5PWK  ; IHS/ASDST/DMJ - 837 PWK Segment 

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

 +2       ;Transaction Set Header

 +3       ;  

START     ;START HERE

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

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

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

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

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

               End DoDot:1

 +6        QUIT 

10        ;segment

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

 +2        QUIT 

20        ;PWK01 - Report Type Code

 +1       ;abm*2.6*1 HEAT6439 ;5010 837p  ;abm*2.6*8

           SET ABMR("PWK",20)=$PIECE($GET(^ABMDCODE($PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U),0)),U)

 +2       ;S ABMR("PWK",20)="EB" ;5010 837P  ;abm*2.6*8

 +3        QUIT 

30        ;PWK02 - Report Transmission Code

 +1       ;5010 837P  ;abm*2.6*8

           SET ABMR("PWK",30)=""

 +2       ;abm*2.6*1 HEAT6439 ;5010 837p  ;abm*2.6*8

           SET ABMR("PWK",30)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U,2)

 +3       ;S ABMR("PWK",30)="FT" ;5010 837P  ;abm*2.6*8

 +4        QUIT 

40        ;PWK03 - Report Copies Needed-not used

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

 +2        QUIT 

50        ;PWK04 - Entity Identifier Code-not used

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

 +2        QUIT 

60        ;PWK05 - Identification Code Qualifier

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

 +2       ;abm*2.6*1 HEAT6439  ;abm*2.6*2 ;5010 837p  ;abm*2.6*8

           SET ABMR("PWK",60)="AC"

 +3       ;5010 837P  ;abm*2.6*8

           SET ABMR("PWK",30)="FT"

 +4       ;abm*2.6*2 ;5010 837p  ;abm*2.6*8

           IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U,3)'=""

               SET ABMR("PWK",60)="AC"

 +5       ;S ABMR("PWK",30)="FT" ;5010 837P

 +6        QUIT 

70        ;PWK06 - Identification Code

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

 +2       ;abm*2.6*1 HEAT6439 ;5010 837P  ;abm*2.6*8

           SET ABMR("PWK",70)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),71,ABM71IEN,0)),U,3)

 +3        QUIT 

80        ;PWK07 - Description

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

 +2        QUIT 

90        ;PWK08 - Actions Indicated-not used

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

 +2        QUIT 

100       ;PWK09 - Request Category Code-not used

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

 +2        QUIT