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")
+1 QUIT
+2 ;Primary Care Provider ID
421GET IF '$DATA(SPECIAL(421))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Primary Prescriber"))
+1 IF '$TEST
XECUTE SPECIAL(421)
+2 QUIT
421FMT IF ABSP("X")'=""
SET ABSP("X")="DL"_$$ANFF^ABSPECFM($GET(ABSP("X")),15)
+1 QUIT
421SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,21)=ABSP("X")
+1 QUIT
+2 ;Primary Care Provider Location Code
469GET IF '$DATA(SPECIAL(469))
SET ABSP("X")=$GET(ABSP("Prescriber",ABSP(9002313.0201),"Prim Care Loc CD"))
+1 IF '$TEST
XECUTE SPECIAL(469)
+2 QUIT
469FMT IF ABSP("X")'=""
SET ABSP("X")="H5"_$$ANFF^ABSPECFM(ABSP("X"),3)
+1 QUIT
469SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,9)=ABSP("X")
+1 QUIT
+2 ;Primary Care Provider Last Name
470GET IF '$DATA(SPECIAL(470))
SET ABSP("X")=$GET(ABSP("Prescriber",ABSP(9002313.0201),"Prim Care Lst Name"))
+1 IF '$TEST
XECUTE SPECIAL(470)
+2 QUIT
470FMT IF ABSP("X")'=""
SET ABSP("X")="4E"_$$ANFF^ABSPECFM(ABSP("X"),15)
+1 QUIT
470SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,10)=ABSP("X")
+1 QUIT
APPEND(FIELD) ;Where outgoing record is built field by field
+1 IF FIELD["111"
Begin DoDot:1
+2 DO @(FIELD_"GET")
+3 DO @(FIELD_"FMT")
+4 SET RECORD=RECORD_$CHAR(30,28)_"AM"_ABSP("X")
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 IF $GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'=""
SET RECORD=RECORD_$CHAR(28)_$GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))
+7 IF '$TEST
IF $DATA(SPECIAL(FIELD))
Begin DoDot:2
+8 XECUTE SPECIAL(FIELD)
+9 DO @(FIELD_"FMT")
+10 SET RECORD=RECORD_$CHAR(28)_ABSP("X")
End DoDot:2
End DoDot:1
+11
*** ERROR ***
