ABSP5B1B.m

ABSP5B1B ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (PRICING,PRESCRIBER, and PROVIDER Segments)

 ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38

PRICING ;EP CALLED FROM ABSP5B1 to set up PRICING SEGMENT

 N FIELD

 S RECORD=$G(RECORD)

 F FIELD="111",409,412,433,438,478,479,480,481,482,483,484,426,430,423 D

 . Q:$D(SUPRESF(FIELD))

 . I (ACTION["CLAIM"),(FIELD'=111) D

 . . D @(FIELD_"GET")

 . . D @(FIELD_"FMT")

 . . D @(FIELD_"SET")

 . ELSE  D APPEND(FIELD)

 Q

 ;Segment identifier

111GET S ABSP("X")=11

 Q

111FMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

 Q

111SET ;This isn't used for the 111 Field

 Q

 ;Ingredient Cost Submitted

409GET I '$D(SPECIAL(409)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Ingredient Cost"))

 ELSE  X SPECIAL(409)

 Q

409FMT S:ABSP("X")'="" ABSP("X")="D9"_$$DFF^ABSPECFM(ABSP("X"),8) ;Spec says Length is 6?

 Q

409SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,9)=ABSP("X")

 Q

 ;Dispensing Fee

412GET I '$D(SPECIAL(412)) D

 . S ABSP("X")=$G(ABSP("Site","Dispensing Fee"))

 . I $D(ABSP("RX",ABSP(9002313.0201),"Dispensing Fee")) S ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Dispensing Fee")

 ELSE  X SPECIAL(412)

 Q

412FMT S:ABSP("X")'="" ABSP("X")="DC"_$$DFF^ABSPECFM(ABSP("X"),8)

 Q

412SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,12)=ABSP("X")

 Q

 ;Patient Paid Amount

433GET I '$D(SPECIAL(433)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Patient Paid Amount"))

 ELSE  X SPECIAL(433)

 Q

433FMT S:ABSP("X")'="" ABSP("X")="DX"_$$DFF^ABSPECFM($G(ABSP("X")),8)

 Q

433SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,3)=ABSP("X")

 Q

 ;Incentive Amount

438GET I '$D(SPECIAL(438)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Incentive Amount"))

 ELSE  X SPECIAL(438)

 Q

438FMT S:ABSP("X")'="" ABSP("X")="E3"_$$DFF^ABSPECFM($G(ABSP("X")),8)

 Q

438SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,8)=ABSP("X")

 Q

 ;Other Amt Clmd Sub Cnt

478GET I '$D(SPECIAL(478)) S ABSP("X")=$G(ABSP("Pricing",ABSP(9002313.0201),"Oth Amt Clmd Sub Cnt"))

 ELSE  X SPECIAL(478)

 Q

478FMT S:ABSP("X")'="" ABSP("X")="H7"_$$NFF^ABSPECFM(ABSP("X"),2)

 Q

478SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),470),U,8)=ABSP("X")

 Q

 ;Other Amount Clmd Sub Qual

479GET I '$D(SPECIAL(479)) S ABSP("X")=$G(ABSP("Pricing","Other Amt Claimed Sub Qual"))

 ELSE  X SPECIAL(479)

 Q

479FMT S:ABSP("X")'="" ABSP("X")="H8"_$$ANFF^ABSPECFM(ABSP("X"),2)

 Q

479SET ;No code exists yet.

 Q

 ;Other amt claimed sub

480GET I '$D(SPECIAL(480)) S ABSP("X")=$G(ABSP("Pricing","Other Amt Claimed Sub"))

 ELSE  X SPECIAL(480)

 Q

480FMT S:ABSP("X")'="" ABSP("X")="H9"_$$DFF^ABSPECFM(ABSP("X"),8)

 Q

480SET ;No code exists yet.

 Q

 ;Flat Sales Tax Amt

481GET I '$D(SPECIAL(481)) S ABSP("X")=$G(ABSP("Pricing",ABSP(9002313.0201),"Flat Sales Tx Amt Sub"))

 ELSE  X SPECIAL(481)

 Q

481FMT S:ABSP("X")'="" ABSP("X")="HA"_$$DFF^ABSPECFM(ABSP("X"),8)

 Q

481SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,1)=ABSP("X")

 Q

 ;Percentage Sales Tax Amt

482GET I '$D(SPECIAL(482)) S ABSP("X")=$G(ABSP("Pricing",ABSP(9002313.0201),"Percnt Sale Tx Amt Sb"))

 ELSE  X SPECIAL(482)

 Q

482FMT S:ABSP("X")'="" ABSP("X")="GE"_$$DFF^ABSPECFM(ABSP("X"),8)

 Q

482SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,2)=ABSP("X")

 Q

 ;Percentage Sales Tax Rate

483GET I '$D(SPECIAL(483)) S ABSP("X")=$G(ABSP("Pricing",ABSP(9002313.0201),"Prcnt Sls Tx Rt Sub"))

 ELSE  X SPECIAL(483)

 Q

483FMT S:ABSP("X")'="" ABSP("X")="HE"_$$DFF^ABSPECFM(ABSP("X"),7)

 Q

483SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,3)=ABSP("X")

 Q

 ;Percentage Sales Tax Basis

484GET I '$D(SPECIAL(484)) S ABSP("X")=$G(ABSP("Pricing",ABSP(9002313.0201),"Prcnt Sls Tx Bs Sub"))

 ELSE  X SPECIAL(484)

 Q

484FMT S:ABSP("X")'="" ABSP("X")="JE"_$$NFF^ABSPECFM(ABSP("X"),2)

 Q

484SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,4)=ABSP("X")

 Q

 ;Usual and Customary Charge

426GET I '$D(SPECIAL(426)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Usual & Customary"))

 ELSE  X SPECIAL(426)

 Q

426FMT S:ABSP("X")'="" ABSP("X")="DQ"_$$DFF^ABSPECFM($G(ABSP("X")),8)

 Q

426SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,26)=ABSP("X")

 Q

 ;Gross Amnt Due

430GET I '$D(SPECIAL(430)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Gross Amount Due"))

 ELSE  X SPECIAL(430)

 Q

430FMT S:ABSP("X")'="" ABSP("X")="DU"_$$DFF^ABSPECFM($G(ABSP("X")),8)

 Q

430SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,30)=ABSP("X")

 Q

 ;Basis of Cost Determination

423GET I '$D(SPECIAL(423)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Basis of Cost Determination"))

 ELSE  X SPECIAL(423)

 Q

423FMT S:ABSP("X")'="" ABSP("X")="DN"_$$ANFF^ABSPECFM($G(ABSP("X")),2)

 Q

423SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,23)=ABSP("X")

 Q

PROVIDER ;EP CALLED FROM ABSP5B1 to set up PROVIDER SEGMENT

 Q:$D(SUPRESSG("Provider"))

 N FIELD

 S RECORD=$G(RECORD)

 F FIELD="111A",465,444 D

 . Q:$D(SUPRESF(FIELD))

 . I (ACTION["CLAIM"),(FIELD'=111) D

 . . D @(FIELD_"GET")

 . . D @(FIELD_"FMT")

 . . D @(FIELD_"SET")

 . ELSE  D APPEND(FIELD)

 Q

 ;Segment identifier

111AGET S ABSP("X")="02"

 Q

111AFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

 Q

111ASET ;This isn't used for the 111 Field

 Q

 ;Provider ID Qualifier

465GET I '$D(SPECIAL(465)) S ABSP("X")=$G(ABSP("Pharmacy",ABSP(9002313.0201),"Provider ID Qual"))

 ELSE  X SPECIAL(465)

 Q

465FMT S:ABSP("X")'="" ABSP("X")="EY"_$$ANFF^ABSPECFM(ABSP("X"),2)

 Q

465SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,5)=ABSP("X")

 Q

 ;Provider ID

444GET I '$D(SPECIAL(444)) S ABSP("X")=$G(ABSP("Pharmacy",ABSP(9002313.0201),"Provider ID"))

 ELSE  X SPECIAL(444)

 Q

444FMT S:ABSP("X")'="" ABSP("X")="E9"_$$ANFF^ABSPECFM(ABSP("X"),15)

 Q

444SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,4)=ABSP("X")

 Q

PRESCRIBER ;EP CALLED FROM ABSP5B1 to set up PRICING SEGMENT

 N FIELD

 S RECORD=$G(RECORD)

 F FIELD="111B",466,411,467,427,498,468,421,469,470 D

 . Q:$D(SUPRESF(FIELD))

 . I (ACTION["CLAIM"),(FIELD'=111) D

 . . D @(FIELD_"GET")

 . . D @(FIELD_"FMT")

 . . D @(FIELD_"SET")

 . ELSE  D APPEND(FIELD)

 Q

 ;Segment identifier

111BGET S ABSP("X")="03"

 Q

111BFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

 Q

111BSET ;This isn't used for the 111 Field

 Q

 ;Prescriber ID Qualifier

466GET I '$D(SPECIAL(466)) S ABSP("X")=$G(ABSP("Prescriber",ABSP(9002313.0201),"Prescriber ID Qual"))

 ELSE  X SPECIAL(466)

 Q

466FMT S:ABSP("X")'="" ABSP("X")="EZ"_$$ANFF^ABSPECFM(ABSP("X"),2)

 Q

466SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,6)=ABSP("X")

 Q

 ;Prescriber ID

411GET I '$D(SPECIAL(411)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Prescriber ID"))

 ELSE  X SPECIAL(411)

 Q

411FMT S:ABSP("X")'="" ABSP("X")="DB"_$$ANFF^ABSPECFM($G(ABSP("X")),15)

 Q

411SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,11)=ABSP("X")

 Q

 ;Prescriber Location Code

467GET I '$D(SPECIAL(467)) S ABSP("X")=$G(ABSP("Prescriber",ABSP(9002313.0201),"Location Code"))

 ELSE  X SPECIAL(467)

 Q

467FMT S:ABSP("X")'="" ABSP("X")="1E"_$$ANFF^ABSPECFM(ABSP("X"),3)

 Q

467SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,7)=ABSP("X")

 Q

 ;Prescriber Last Name

427GET I '$D(SPECIAL(427)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Prescriber Last Name"))

 ELSE  X SPECIAL(427)

 Q

427FMT S:ABSP("X")'="" ABSP("X")="DR"_$$ANFF^ABSPECFM(ABSP("X"),15)

 Q

427SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),420),U,27)=ABSP("X")

 Q

 ;Prescriber Phone Number

498GET I '$D(SPECIAL(498)) S ABSP("X")=$G(ABSP("Prescriber",ABSP(9002313.0201),"Phone"))

 ELSE  X SPECIAL(498)

 Q

498FMT S:ABSP("X")'="" ABSP("X")="PM"_$$ANFF^ABSPECFM($G(ABSP("X")),10)

 Q

498SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,12)=ABSP("X")

 Q

 ;Primary Care Provider ID Qual

468GET I '$D(SPECIAL(468)) S ABSP("X")=$G(ABSP("Prescriber",ABSP(9002313.0201),"Prim Care ID Qual"))

 ELSE  X SPECIAL(468)

 Q

468FMT S:ABSP("X")'="" ABSP("X")="2E"_$$ANFF^ABSPECFM(ABSP("X"),2)

 Q

468SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,8)=ABSP("X")

 Q

 ;Primary Care Provider ID

421GET I '$D(SPECIAL(421)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Primary Prescriber"))

 ELSE  X SPECIAL(421)

 Q

421FMT S:ABSP("X")'="" ABSP("X")="DL"_$$ANFF^ABSPECFM($G(ABSP("X")),15)

 Q

421SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,21)=ABSP("X")

 Q

 ;Primary Care Provider Location Code

469GET I '$D(SPECIAL(469)) S ABSP("X")=$G(ABSP("Prescriber",ABSP(9002313.0201),"Prim Care Loc CD"))

 ELSE  X SPECIAL(469)

 Q

469FMT S:ABSP("X")'="" ABSP("X")="H5"_$$ANFF^ABSPECFM(ABSP("X"),3)

 Q

469SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,9)=ABSP("X")

 Q

 ;Primary Care Provider Last Name

470GET I '$D(SPECIAL(470)) S ABSP("X")=$G(ABSP("Prescriber",ABSP(9002313.0201),"Prim Care Lst Name"))

 ELSE  X SPECIAL(470)

 Q

470FMT S:ABSP("X")'="" ABSP("X")="4E"_$$ANFF^ABSPECFM(ABSP("X"),15)

 Q

470SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,10)=ABSP("X")

 Q

APPEND(FIELD) ;Where outgoing record is built field by field

 I FIELD["111" D

 . D @(FIELD_"GET")

 . D @(FIELD_"FMT")

 . S RECORD=RECORD_$C(30,28)_"AM"_ABSP("X")

 ELSE  D

 . I $G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'="" S RECORD=RECORD_$C(28)_$G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))

 . ELSE  I $D(SPECIAL(FIELD)) D

 . . X SPECIAL(FIELD)

 . . D @(FIELD_"FMT")

 . . S RECORD=RECORD_$C(28)_ABSP("X")

 Q	

ABSP5B1B  ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (PRICING,PRESCRIBER, and PROVIDER Segments)

 +1       ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38

PRICING   ;EP CALLED FROM ABSP5B1 to set up PRICING SEGMENT

 +1        NEW FIELD

 +2        SET RECORD=$GET(RECORD)

 +3        FOR FIELD="111",409,412,433,438,478,479,480,481,482,483,484,426,430,423

               Begin DoDot:1

 +4                IF $DATA(SUPRESF(FIELD))

                       QUIT 

 +5                IF (ACTION["CLAIM")

                       IF (FIELD'=111)

                           Begin DoDot:2

 +6                            DO @(FIELD_"GET")

 +7                            DO @(FIELD_"FMT")

 +8                            DO @(FIELD_"SET")

                           End DoDot:2

 +9               IF '$TEST

                       DO APPEND(FIELD)

               End DoDot:1

 +10       QUIT 

 +11      ;Segment identifier

111GET     SET ABSP("X")=11

 +1        QUIT 

111FMT     SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

111SET    ;This isn't used for the 111 Field

 +1        QUIT 

 +2       ;Ingredient Cost Submitted

409GET     IF '$DATA(SPECIAL(409))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Ingredient Cost"))

 +1       IF '$TEST

               XECUTE SPECIAL(409)

 +2        QUIT 

409FMT    ;Spec says Length is 6?

           IF ABSP("X")'=""

               SET ABSP("X")="D9"_$$DFF^ABSPECFM(ABSP("X"),8)

 +1        QUIT 

409SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,9)=ABSP("X")

 +1        QUIT 

 +2       ;Dispensing Fee

412GET     IF '$DATA(SPECIAL(412))

               Begin DoDot:1

 +1                SET ABSP("X")=$GET(ABSP("Site","Dispensing Fee"))

 +2                IF $DATA(ABSP("RX",ABSP(9002313.0201),"Dispensing Fee"))

                       SET ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Dispensing Fee")

               End DoDot:1

 +3       IF '$TEST

               XECUTE SPECIAL(412)

 +4        QUIT 

412FMT     IF ABSP("X")'=""

               SET ABSP("X")="DC"_$$DFF^ABSPECFM(ABSP("X"),8)

 +1        QUIT 

412SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,12)=ABSP("X")

 +1        QUIT 

 +2       ;Patient Paid Amount

433GET     IF '$DATA(SPECIAL(433))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Patient Paid Amount"))

 +1       IF '$TEST

               XECUTE SPECIAL(433)

 +2        QUIT 

433FMT     IF ABSP("X")'=""

               SET ABSP("X")="DX"_$$DFF^ABSPECFM($GET(ABSP("X")),8)

 +1        QUIT 

433SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,3)=ABSP("X")

 +1        QUIT 

 +2       ;Incentive Amount

438GET     IF '$DATA(SPECIAL(438))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Incentive Amount"))

 +1       IF '$TEST

               XECUTE SPECIAL(438)

 +2        QUIT 

438FMT     IF ABSP("X")'=""

               SET ABSP("X")="E3"_$$DFF^ABSPECFM($GET(ABSP("X")),8)

 +1        QUIT 

438SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,8)=ABSP("X")

 +1        QUIT 

 +2       ;Other Amt Clmd Sub Cnt

478GET     IF '$DATA(SPECIAL(478))

               SET ABSP("X")=$GET(ABSP("Pricing",ABSP(9002313.0201),"Oth Amt Clmd Sub Cnt"))

 +1       IF '$TEST

               XECUTE SPECIAL(478)

 +2        QUIT 

478FMT     IF ABSP("X")'=""

               SET ABSP("X")="H7"_$$NFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

478SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),470),U,8)=ABSP("X")

 +1        QUIT 

 +2       ;Other Amount Clmd Sub Qual

479GET     IF '$DATA(SPECIAL(479))

               SET ABSP("X")=$GET(ABSP("Pricing","Other Amt Claimed Sub Qual"))

 +1       IF '$TEST

               XECUTE SPECIAL(479)

 +2        QUIT 

479FMT     IF ABSP("X")'=""

               SET ABSP("X")="H8"_$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

479SET    ;No code exists yet.

 +1        QUIT 

 +2       ;Other amt claimed sub

480GET     IF '$DATA(SPECIAL(480))

               SET ABSP("X")=$GET(ABSP("Pricing","Other Amt Claimed Sub"))

 +1       IF '$TEST

               XECUTE SPECIAL(480)

 +2        QUIT 

480FMT     IF ABSP("X")'=""

               SET ABSP("X")="H9"_$$DFF^ABSPECFM(ABSP("X"),8)

 +1        QUIT 

480SET    ;No code exists yet.

 +1        QUIT 

 +2       ;Flat Sales Tax Amt

481GET     IF '$DATA(SPECIAL(481))

               SET ABSP("X")=$GET(ABSP("Pricing",ABSP(9002313.0201),"Flat Sales Tx Amt Sub"))

 +1       IF '$TEST

               XECUTE SPECIAL(481)

 +2        QUIT 

481FMT     IF ABSP("X")'=""

               SET ABSP("X")="HA"_$$DFF^ABSPECFM(ABSP("X"),8)

 +1        QUIT 

481SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,1)=ABSP("X")

 +1        QUIT 

 +2       ;Percentage Sales Tax Amt

482GET     IF '$DATA(SPECIAL(482))

               SET ABSP("X")=$GET(ABSP("Pricing",ABSP(9002313.0201),"Percnt Sale Tx Amt Sb"))

 +1       IF '$TEST

               XECUTE SPECIAL(482)

 +2        QUIT 

482FMT     IF ABSP("X")'=""

               SET ABSP("X")="GE"_$$DFF^ABSPECFM(ABSP("X"),8)

 +1        QUIT 

482SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,2)=ABSP("X")

 +1        QUIT 

 +2       ;Percentage Sales Tax Rate

483GET     IF '$DATA(SPECIAL(483))

               SET ABSP("X")=$GET(ABSP("Pricing",ABSP(9002313.0201),"Prcnt Sls Tx Rt Sub"))

 +1       IF '$TEST

               XECUTE SPECIAL(483)

 +2        QUIT 

483FMT     IF ABSP("X")'=""

               SET ABSP("X")="HE"_$$DFF^ABSPECFM(ABSP("X"),7)

 +1        QUIT 

483SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,3)=ABSP("X")

 +1        QUIT 

 +2       ;Percentage Sales Tax Basis

484GET     IF '$DATA(SPECIAL(484))

               SET ABSP("X")=$GET(ABSP("Pricing",ABSP(9002313.0201),"Prcnt Sls Tx Bs Sub"))

 +1       IF '$TEST

               XECUTE SPECIAL(484)

 +2        QUIT 

484FMT     IF ABSP("X")'=""

               SET ABSP("X")="JE"_$$NFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

484SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),480),U,4)=ABSP("X")

 +1        QUIT 

 +2       ;Usual and Customary Charge

426GET     IF '$DATA(SPECIAL(426))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Usual & Customary"))

 +1       IF '$TEST

               XECUTE SPECIAL(426)

 +2        QUIT 

426FMT     IF ABSP("X")'=""

               SET ABSP("X")="DQ"_$$DFF^ABSPECFM($GET(ABSP("X")),8)

 +1        QUIT 

426SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,26)=ABSP("X")

 +1        QUIT 

 +2       ;Gross Amnt Due

430GET     IF '$DATA(SPECIAL(430))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Gross Amount Due"))

 +1       IF '$TEST

               XECUTE SPECIAL(430)

 +2        QUIT 

430FMT     IF ABSP("X")'=""

               SET ABSP("X")="DU"_$$DFF^ABSPECFM($GET(ABSP("X")),8)

 +1        QUIT 

430SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,30)=ABSP("X")

 +1        QUIT 

 +2       ;Basis of Cost Determination

423GET     IF '$DATA(SPECIAL(423))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Basis of Cost Determination"))

 +1       IF '$TEST

               XECUTE SPECIAL(423)

 +2        QUIT 

423FMT     IF ABSP("X")'=""

               SET ABSP("X")="DN"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)

 +1        QUIT 

423SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,23)=ABSP("X")

 +1        QUIT 

PROVIDER  ;EP CALLED FROM ABSP5B1 to set up PROVIDER SEGMENT

 +1        IF $DATA(SUPRESSG("Provider"))

               QUIT 

 +2        NEW FIELD

 +3        SET RECORD=$GET(RECORD)

 +4        FOR FIELD="111A",465,444

               Begin DoDot:1

 +5                IF $DATA(SUPRESF(FIELD))

                       QUIT 

 +6                IF (ACTION["CLAIM")

                       IF (FIELD'=111)

                           Begin DoDot:2

 +7                            DO @(FIELD_"GET")

 +8                            DO @(FIELD_"FMT")

 +9                            DO @(FIELD_"SET")

                           End DoDot:2

 +10              IF '$TEST

                       DO APPEND(FIELD)

               End DoDot:1

 +11       QUIT 

 +12      ;Segment identifier

111AGET    SET ABSP("X")="02"

 +1        QUIT 

111AFMT    SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

111ASET   ;This isn't used for the 111 Field

 +1        QUIT 

 +2       ;Provider ID Qualifier

465GET     IF '$DATA(SPECIAL(465))

               SET ABSP("X")=$GET(ABSP("Pharmacy",ABSP(9002313.0201),"Provider ID Qual"))

 +1       IF '$TEST

               XECUTE SPECIAL(465)

 +2        QUIT 

465FMT     IF ABSP("X")'=""

               SET ABSP("X")="EY"_$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

465SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,5)=ABSP("X")

 +1        QUIT 

 +2       ;Provider ID

444GET     IF '$DATA(SPECIAL(444))

               SET ABSP("X")=$GET(ABSP("Pharmacy",ABSP(9002313.0201),"Provider ID"))

 +1       IF '$TEST

               XECUTE SPECIAL(444)

 +2        QUIT 

444FMT     IF ABSP("X")'=""

               SET ABSP("X")="E9"_$$ANFF^ABSPECFM(ABSP("X"),15)

 +1        QUIT 

444SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,4)=ABSP("X")

 +1        QUIT 

PRESCRIBER ;EP CALLED FROM ABSP5B1 to set up PRICING SEGMENT

 +1        NEW FIELD

 +2        SET RECORD=$GET(RECORD)

 +3        FOR FIELD="111B",466,411,467,427,498,468,421,469,470

               Begin DoDot:1

 +4                IF $DATA(SUPRESF(FIELD))

                       QUIT 

 +5                IF (ACTION["CLAIM")

                       IF (FIELD'=111)

                           Begin DoDot:2

 +6                            DO @(FIELD_"GET")

 +7                            DO @(FIELD_"FMT")

 +8                            DO @(FIELD_"SET")

                           End DoDot:2

 +9               IF '$TEST

                       DO APPEND(FIELD)

               End DoDot:1

 +10       QUIT 

 +11      ;Segment identifier

111BGET    SET ABSP("X")="03"

 +1        QUIT 

111BFMT    SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

111BSET   ;This isn't used for the 111 Field

 +1        QUIT 

 +2       ;Prescriber ID Qualifier

466GET     IF '$DATA(SPECIAL(466))

               SET ABSP("X")=$GET(ABSP("Prescriber",ABSP(9002313.0201),"Prescriber ID Qual"))

 +1       IF '$TEST

               XECUTE SPECIAL(466)

 +2        QUIT 

466FMT     IF ABSP("X")'=""

               SET ABSP("X")="EZ"_$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

466SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,6)=ABSP("X")

 +1        QUIT 

 +2       ;Prescriber ID

411GET     IF '$DATA(SPECIAL(411))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Prescriber ID"))

 +1       IF '$TEST

               XECUTE SPECIAL(411)

 +2        QUIT 

411FMT     IF ABSP("X")'=""

               SET ABSP("X")="DB"_$$ANFF^ABSPECFM($GET(ABSP("X")),15)

 +1        QUIT 

411SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,11)=ABSP("X")

 +1        QUIT 

 +2       ;Prescriber Location Code

467GET     IF '$DATA(SPECIAL(467))

               SET ABSP("X")=$GET(ABSP("Prescriber",ABSP(9002313.0201),"Location Code"))

 +1       IF '$TEST

               XECUTE SPECIAL(467)

 +2        QUIT 

467FMT     IF ABSP("X")'=""

               SET ABSP("X")="1E"_$$ANFF^ABSPECFM(ABSP("X"),3)

 +1        QUIT 

467SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,7)=ABSP("X")

 +1        QUIT 

 +2       ;Prescriber Last Name

427GET     IF '$DATA(SPECIAL(427))

               SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Prescriber Last Name"))

 +1       IF '$TEST

               XECUTE SPECIAL(427)

 +2        QUIT 

427FMT     IF ABSP("X")'=""

               SET ABSP("X")="DR"_$$ANFF^ABSPECFM(ABSP("X"),15)

 +1        QUIT 

427SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),420),U,27)=ABSP("X")

 +1        QUIT 

 +2       ;Prescriber Phone Number

498GET     IF '$DATA(SPECIAL(498))

               SET ABSP("X")=$GET(ABSP("Prescriber",ABSP(9002313.0201),"Phone"))

 +1       IF '$TEST

               XECUTE SPECIAL(498)

 +2        QUIT 

498FMT     IF ABSP("X")'=""

               SET ABSP("X")="PM"_$$ANFF^ABSPECFM($GET(ABSP("X")),10)

 +1        QUIT 

498SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),498),U,12)=ABSP("X")

 +1        QUIT 

 +2       ;Primary Care Provider ID Qual

468GET     IF '$DATA(SPECIAL(468))

               SET ABSP("X")=$GET(ABSP("Prescriber",ABSP(9002313.0201),"Prim Care ID Qual"))

 +1       IF '$TEST

               XECUTE SPECIAL(468)

 +2        QUIT 

468FMT     IF ABSP("X")'=""

               SET ABSP("X")="2E"_$$ANFF^ABSPECFM(ABSP("X"),2)

 +1        QUIT 

468SET     SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,8)=ABSP("X")