ABSP5B1A ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (Claim Segment)
;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
;
CLAIM ;EP CALLED FROM ABSP5B1 to set up CLAIM SEGMENT
N FIELD
S RECORD=$G(RECORD)
F FIELD="111",455,402,436,407,456,457,458,459,442,403,405,406,408,414,415,419,420,460,308,429,453,445,446,330,454,600,418,461,462,463,464,343,344,345 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")="07"
Q
111FMT S:ABSP("X")'="" ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
Q
111SET ;This isn't used for the 111 Field
Q
;Presc Srv Ref Qualifier
455GET I '$D(SPECIAL(455)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Pres Srv Ref Qual"))
ELSE X SPECIAL(455)
Q
455FMT S:ABSP("X")'="" ABSP("X")="EM"_$$ANFF^ABSPECFM(ABSP("X"),1)
Q
455SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,5)=ABSP("X")
Q
;Presc Srv Ref Number
402GET I '$D(SPECIAL(402)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"RX Number"))
ELSE X SPECIAL(402)
Q
402FMT I $L(ABSP("X"))>7 S ABSP("X")=$E(ABSP("X"),$L(ABSP("X"))-6,$L(ABSP("X")))
S:ABSP("X")'="" ABSP("X")="D2"_$$NFF^ABSPECFM($G(ABSP("X")),7)
Q
402SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,2)=ABSP("X")
Q
;Product Serv ID Qualifer
436GET I '$D(SPECIAL(436)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Alt. Product Type"))
ELSE X SPECIAL(436)
Q
436FMT S:ABSP("X")'="" ABSP("X")="E1"_$$ANFF^ABSPECFM(ABSP("X"),2)
Q
436SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,6)=ABSP("X")
Q
;Product Serv ID
407GET I '$D(SPECIAL(407)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"NDC"))
. S ABSP("X")=$$NDCF^ABSPECFM(ABSP("X"))
ELSE X SPECIAL(407)
Q
407FMT S:ABSP("X")'="" ABSP("X")="D7"_$$ANFF^ABSPECFM(ABSP("X"),$L(ABSP("X"))) ;Spec says length is 19?
Q
407SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,7)=ABSP("X")
Q
;Assoc Pres Srv Ref Number
456GET I '$D(SPECIAL(456)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Assoc Pres Number"))
ELSE X SPECIAL(456)
Q
456FMT S:ABSP("X")'="" ABSP("X")="EN"_$$NFF^ABSPECFM(ABSP("X"),7)
Q
456SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,6)=ABSP("X")
Q
;Assoc Pres Serv Date
457GET I '$D(SPECIAL(457)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Assoc Pres Date"))
ELSE X SPECIAL(457)
Q
457FMT S:ABSP("X")'="" ABSP("X")="EP"_$$NFF^ABSPECFM(ABSP("X"),8)
Q
457SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,7)=ABSP("X")
Q
;Procedure Modifier Code Count
458GET I '$D(SPECIAL(458)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Proc Mod Cd Cnt"))
ELSE X SPECIAL(458)
Q
458FMT S:ABSP("X")'="" ABSP("X")="SE"_$$NFF^ABSPECFM(ABSP("X"),1)
Q
458SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,8)=ABSP("X")
Q
;Procedure Modifier Code
459GET I '$D(SPECIAL(459)) S ABSP("X")=""
ELSE X SPECIAL(459)
Q
459FMT S:ABSP("X")'="" ABSP("X")="ER"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
459SET ;Not Yet Implemented
Q
;Quantity Dispensed
442GET I '$D(SPECIAL(442)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Quantity"))*1000
. S:$D(ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity")) ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity")
ELSE X SPECIAL(442)
Q
442FMT S:ABSP("X")'="" ABSP("X")="E7"_$$NFF^ABSPECFM(ABSP("X"),10) ;Spec says length is 7
Q
442SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,2)=ABSP("X")
Q
;Fill Number
403GET I '$D(SPECIAL(403)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Refill #"))
ELSE X SPECIAL(403)
Q
403FMT S:ABSP("X")'="" ABSP("X")="D3"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
403SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,3)=ABSP("X")
Q
;Days Supply
405GET I '$D(SPECIAL(405)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Days Supply"))
ELSE X SPECIAL(405)
Q
405FMT S:ABSP("X")'="" ABSP("X")="D5"_$$NFF^ABSPECFM(ABSP("X"),3)
Q
405SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,5)=ABSP("X")
Q
;Compound Code
406GET I '$D(SPECIAL(406)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Compound Code"))
. S:ABSP("X")="" ABSP("X")=1
ELSE X SPECIAL(406)
Q
406FMT S:ABSP("X")'="" ABSP("X")="D6"_$$NFF^ABSPECFM(ABSP("X"),1)
Q
406SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,6)=ABSP("X")
Q
;Dispense as written
408GET I '$D(SPECIAL(408)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"DAW"))
. S:ABSP("X")="" ABSP("X")=0
ELSE X SPECIAL(408)
Q
408FMT S:ABSP("X")'="" ABSP("X")="D8"_$$ANFF^ABSPECFM(ABSP("X"),1)
Q
408SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,8)=ABSP("X")
Q
;Date Presc Written
414GET I '$D(SPECIAL(414)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Date Written"))
. S ABSP("X")=$$DTF1^ABSPECFM(ABSP("X"))
ELSE X SPECIAL(414)
Q
414FMT S:ABSP("X")'="" ABSP("X")="DE"_$$NFF^ABSPECFM(ABSP("X"),8)
Q
414SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,14)=ABSP("X")
Q
;Number Refills Authorized
415GET I '$D(SPECIAL(415)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"# Refills"))
ELSE X SPECIAL(415)
Q
415FMT S:ABSP("X")'="" ABSP("X")="DF"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
415SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,15)=ABSP("X")
Q
;Prescription Origin Code
419GET I '$D(SPECIAL(419)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Origin Code"))
. S:ABSP("X")="" ABSP("X")="1"
ELSE X SPECIAL(419)
Q
419FMT S:ABSP("X")'="" ABSP("X")="DJ"_$$NFF^ABSPECFM(ABSP("X"),1)
Q
419SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,19)=ABSP("X")
Q
;Submission Clarification Code
420GET I '$D(SPECIAL(420)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Clarification"))
. S:ABSP("X")="" ABSP("X")="00"
ELSE X SPECIAL(420)
Q
420FMT S:ABSP("X")'="" ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
420SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,20)=ABSP("X")
Q
;Quantity Prescribed
460GET I '$D(SPECIAL(460)) D
. S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Quantity"))*1000
. S:$D(ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity")) ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity")
ELSE X SPECIAL(460)
Q
460FMT S:ABSP("X")'="" ABSP("X")="ET"_$$NFF^ABSPECFM(ABSP("X"),10)
Q
460SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,10)=ABSP("X")
Q
;Other Coverage Code
308GET I '$D(SPECIAL(308)) D
. S ABSP("X")=$G(ABSP("Patient","Other Coverage Code"))
. S:$G(ABSP(9002313.0201))'="" ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"CC"))
. S:'ABSP("X") ABSP("X")=1
ELSE X SPECIAL(308)
Q
308FMT S:ABSP("X")'="" ABSP("X")="C8"_$$NFF^ABSPECFM($G(ABSP("X")),2)
Q
308SET D FLD308^ABSPOSSG
Q
;Unit Dose Indicator
429GET I '$D(SPECIAL(429)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Unit Dose Indicator"))
ELSE X SPECIAL(429)
Q
429FMT S:ABSP("X")'="" ABSP("X")="DT"_$$NFF^ABSPECFM($G(ABSP("X")),1)
Q
429SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,29)=ABSP("X")
Q
;Orig Presc Prod/Serv ID Qual
453GET I '$D(SPECIAL(453)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Orig Pres Prod Qual"))
ELSE X SPECIAL(453)
Q
453FMT S:ABSP("X")'="" ABSP("X")="EJ"_$$ANFF^ABSPECFM(ABSP("X"),2)
Q
453SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,3)=ABSP("X")
Q
;Orig Presc Prod/Serv Code
445GET I '$D(SPECIAL(445)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Orig Pres Prod"))
ELSE X SPECIAL(445)
Q
445FMT S:ABSP("X")'="" ABSP("X")="EA"_$$ANFF^ABSPECFM(ABSP("X"),19)
Q
445SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,5)=ABSP("X")
Q
;Originally Prescribed Quantity
446GET I '$D(SPECIAL(446)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Org Pres Qty"))
ELSE X SPECIAL(446)
Q
446FMT S:ABSP("X")'="" ABSP("X")="EB"_$$NFF^ABSPECFM(ABSP("X"),10) ;Spec says length is 7?
Q
446SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,6)=ABSP("X")
Q
;Alternate ID
330GET I '$D(SPECIAL(330)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Alternate ID"))
ELSE X SPECIAL(330)
Q
330FMT S:ABSP("X")'="" ABSP("X")="CW"_$$ANFF^ABSPECFM(ABSP("X"),20)
Q
330SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),320),U,10)=ABSP("X")
Q
;Scheduled Pres ID Number
454GET I '$D(SPECIAL(454)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Schd Pres ID Num"))
ELSE X SPECIAL(454)
Q
454FMT S:ABSP("X")'="" ABSP("X")="EK"_$$ANFF^ABSPECFM(ABSP("X"),12)
Q
454SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,4)=ABSP("X")
Q
;Unit of measure
600GET I '$D(SPECIAL(600)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Unit of Measure"))
ELSE X SPECIAL(600)
Q
600FMT S:ABSP("X")'="" ABSP("X")="28"_$$ANFF^ABSPECFM(ABSP("X"),2)
Q
600SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),600),U,1)=ABSP("X")
Q
;Level of Service
418GET I '$D(SPECIAL(418)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Level of Service"))
ELSE X SPECIAL(418)
Q
418FMT S:ABSP("X")'="" ABSP("X")="DI"_$$NFF^ABSPECFM($G(ABSP("X")),2)
Q
418SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,18)=ABSP("X")
Q
;Prior Authorization Type Code
461GET I '$D(SPECIAL(461)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Prior Auth Type"))
ELSE X SPECIAL(461)
Q
461FMT S:ABSP("X")'="" ABSP("X")="EU"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
461SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,1)=ABSP("X")
Q
;Prior Authorization Num Sub
462GET I '$D(SPECIAL(462)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Prior Auth Num Sub"))
ELSE X SPECIAL(462)
Q
462FMT S:ABSP("X")'="" ABSP("X")="EV"_$$NFF^ABSPECFM(ABSP("X"),11)
Q
462SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,2)=ABSP("X")
Q
;Intermediary Auth Type ID
463GET I '$D(SPECIAL(463)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Inter Auth Type"))
ELSE X SPECIAL(463)
Q
463FMT S:ABSP("X")'="" ABSP("X")="EW"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
463SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,3)=ABSP("X")
Q
;Intermediary Auth ID
464GET I '$D(SPECIAL(464)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Inter Auth"))
ELSE X SPECIAL(464)
Q
464FMT S:ABSP("X")'="" ABSP("X")="EX"_$$ANFF^ABSPECFM(ABSP("X"),11)
Q
464SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,4)=ABSP("X")
Q
;Dispensing Status
343GET I '$D(SPECIAL(343)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Dispensing Status"))
ELSE X SPECIAL(343)
Q
343FMT S:ABSP("X")'="" ABSP("X")="HD"_$$ANFF^ABSPECFM(ABSP("X"),1)
Q
343SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),340),U,3)=ABSP("X")
Q
;Qty intended to be dispensed
344GET I '$D(SPECIAL(344)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Qty Intd Dispd"))
ELSE X SPECIAL(344)
Q
344FMT S:ABSP("X")'="" ABSP("X")="HF"_$$NFF^ABSPECFM(ABSP("X"),10) ;Spec says length is 7?
Q
344SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),340),U,4)=ABSP("X")
Q
;Day Supply Intd Dispensed
345GET I '$D(SPECIAL(345)) S ABSP("X")=$G(ABSP("Claim",ABSP(9002313.0201),"Days Sup Intd Dispd"))
ELSE X SPECIAL(345)
Q
345FMT S:ABSP("X")'="" ABSP("X")="HG"_$$NFF^ABSPECFM(ABSP("X"),3)
Q
345SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),340),U,5)=ABSP("X")
Q
APPEND(FIELD) ;This is where the 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
ABSP5B1A ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for 5.1 (Claim Segment)
+1 ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
+2 ;
CLAIM ;EP CALLED FROM ABSP5B1 to set up CLAIM SEGMENT
+1 NEW FIELD
+2 SET RECORD=$GET(RECORD)
+3 FOR FIELD="111",455,402,436,407,456,457,458,459,442,403,405,406,408,414,415,419,420,460,308,429,453,445,446,330,454,600,418,461,462,463,464,343,344,345
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")="07"
+1 QUIT
111FMT IF ABSP("X")'=""
SET ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
111SET ;This isn't used for the 111 Field
+1 QUIT
+2 ;Presc Srv Ref Qualifier
455GET IF '$DATA(SPECIAL(455))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Pres Srv Ref Qual"))
+1 IF '$TEST
XECUTE SPECIAL(455)
+2 QUIT
455FMT IF ABSP("X")'=""
SET ABSP("X")="EM"_$$ANFF^ABSPECFM(ABSP("X"),1)
+1 QUIT
455SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,5)=ABSP("X")
+1 QUIT
+2 ;Presc Srv Ref Number
402GET IF '$DATA(SPECIAL(402))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"RX Number"))
+1 IF '$TEST
XECUTE SPECIAL(402)
+2 QUIT
402FMT IF $LENGTH(ABSP("X"))>7
SET ABSP("X")=$EXTRACT(ABSP("X"),$LENGTH(ABSP("X"))-6,$LENGTH(ABSP("X")))
+1 IF ABSP("X")'=""
SET ABSP("X")="D2"_$$NFF^ABSPECFM($GET(ABSP("X")),7)
+2 QUIT
402SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,2)=ABSP("X")
+1 QUIT
+2 ;Product Serv ID Qualifer
436GET IF '$DATA(SPECIAL(436))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Alt. Product Type"))
+1 IF '$TEST
XECUTE SPECIAL(436)
+2 QUIT
436FMT IF ABSP("X")'=""
SET ABSP("X")="E1"_$$ANFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
436SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,6)=ABSP("X")
+1 QUIT
+2 ;Product Serv ID
407GET IF '$DATA(SPECIAL(407))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"NDC"))
+2 SET ABSP("X")=$$NDCF^ABSPECFM(ABSP("X"))
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(407)
+4 QUIT
407FMT ;Spec says length is 19?
IF ABSP("X")'=""
SET ABSP("X")="D7"_$$ANFF^ABSPECFM(ABSP("X"),$LENGTH(ABSP("X")))
+1 QUIT
407SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,7)=ABSP("X")
+1 QUIT
+2 ;Assoc Pres Srv Ref Number
456GET IF '$DATA(SPECIAL(456))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Assoc Pres Number"))
+1 IF '$TEST
XECUTE SPECIAL(456)
+2 QUIT
456FMT IF ABSP("X")'=""
SET ABSP("X")="EN"_$$NFF^ABSPECFM(ABSP("X"),7)
+1 QUIT
456SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,6)=ABSP("X")
+1 QUIT
+2 ;Assoc Pres Serv Date
457GET IF '$DATA(SPECIAL(457))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Assoc Pres Date"))
+1 IF '$TEST
XECUTE SPECIAL(457)
+2 QUIT
457FMT IF ABSP("X")'=""
SET ABSP("X")="EP"_$$NFF^ABSPECFM(ABSP("X"),8)
+1 QUIT
457SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,7)=ABSP("X")
+1 QUIT
+2 ;Procedure Modifier Code Count
458GET IF '$DATA(SPECIAL(458))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Proc Mod Cd Cnt"))
+1 IF '$TEST
XECUTE SPECIAL(458)
+2 QUIT
458FMT IF ABSP("X")'=""
SET ABSP("X")="SE"_$$NFF^ABSPECFM(ABSP("X"),1)
+1 QUIT
458SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,8)=ABSP("X")
+1 QUIT
+2 ;Procedure Modifier Code
459GET IF '$DATA(SPECIAL(459))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(459)
+2 QUIT
459FMT IF ABSP("X")'=""
SET ABSP("X")="ER"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
459SET ;Not Yet Implemented
+1 QUIT
+2 ;Quantity Dispensed
442GET IF '$DATA(SPECIAL(442))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Quantity"))*1000
+2 IF $DATA(ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity"))
SET ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity")
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(442)
+4 QUIT
442FMT ;Spec says length is 7
IF ABSP("X")'=""
SET ABSP("X")="E7"_$$NFF^ABSPECFM(ABSP("X"),10)
+1 QUIT
442SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,2)=ABSP("X")
+1 QUIT
+2 ;Fill Number
403GET IF '$DATA(SPECIAL(403))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Refill #"))
+1 IF '$TEST
XECUTE SPECIAL(403)
+2 QUIT
403FMT IF ABSP("X")'=""
SET ABSP("X")="D3"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
403SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,3)=ABSP("X")
+1 QUIT
+2 ;Days Supply
405GET IF '$DATA(SPECIAL(405))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Days Supply"))
+1 IF '$TEST
XECUTE SPECIAL(405)
+2 QUIT
405FMT IF ABSP("X")'=""
SET ABSP("X")="D5"_$$NFF^ABSPECFM(ABSP("X"),3)
+1 QUIT
405SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,5)=ABSP("X")
+1 QUIT
+2 ;Compound Code
406GET IF '$DATA(SPECIAL(406))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Compound Code"))
+2 IF ABSP("X")=""
SET ABSP("X")=1
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(406)
+4 QUIT
406FMT IF ABSP("X")'=""
SET ABSP("X")="D6"_$$NFF^ABSPECFM(ABSP("X"),1)
+1 QUIT
406SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,6)=ABSP("X")
+1 QUIT
+2 ;Dispense as written
408GET IF '$DATA(SPECIAL(408))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"DAW"))
+2 IF ABSP("X")=""
SET ABSP("X")=0
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(408)
+4 QUIT
408FMT IF ABSP("X")'=""
SET ABSP("X")="D8"_$$ANFF^ABSPECFM(ABSP("X"),1)
+1 QUIT
408SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,8)=ABSP("X")
+1 QUIT
+2 ;Date Presc Written
414GET IF '$DATA(SPECIAL(414))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Date Written"))
+2 SET ABSP("X")=$$DTF1^ABSPECFM(ABSP("X"))
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(414)
+4 QUIT
414FMT IF ABSP("X")'=""
SET ABSP("X")="DE"_$$NFF^ABSPECFM(ABSP("X"),8)
+1 QUIT
414SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,14)=ABSP("X")
+1 QUIT
+2 ;Number Refills Authorized
415GET IF '$DATA(SPECIAL(415))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"# Refills"))
+1 IF '$TEST
XECUTE SPECIAL(415)
+2 QUIT
415FMT IF ABSP("X")'=""
SET ABSP("X")="DF"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
415SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,15)=ABSP("X")
+1 QUIT
+2 ;Prescription Origin Code
419GET IF '$DATA(SPECIAL(419))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Origin Code"))
+2 IF ABSP("X")=""
SET ABSP("X")="1"
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(419)
+4 QUIT
419FMT IF ABSP("X")'=""
SET ABSP("X")="DJ"_$$NFF^ABSPECFM(ABSP("X"),1)
+1 QUIT
419SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,19)=ABSP("X")
+1 QUIT
+2 ;Submission Clarification Code
420GET IF '$DATA(SPECIAL(420))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Clarification"))
+2 IF ABSP("X")=""
SET ABSP("X")="00"
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(420)
+4 QUIT
420FMT IF ABSP("X")'=""
SET ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
420SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,20)=ABSP("X")
+1 QUIT
+2 ;Quantity Prescribed
460GET IF '$DATA(SPECIAL(460))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Quantity"))*1000
+2 IF $DATA(ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity"))
SET ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Metric Decimal Quantity")
End DoDot:1
+3 IF '$TEST
XECUTE SPECIAL(460)
+4 QUIT
460FMT IF ABSP("X")'=""
SET ABSP("X")="ET"_$$NFF^ABSPECFM(ABSP("X"),10)
+1 QUIT
460SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,10)=ABSP("X")
+1 QUIT
+2 ;Other Coverage Code
308GET IF '$DATA(SPECIAL(308))
Begin DoDot:1
+1 SET ABSP("X")=$GET(ABSP("Patient","Other Coverage Code"))
+2 IF $GET(ABSP(9002313.0201))'=""
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"CC"))
+3 IF 'ABSP("X")
SET ABSP("X")=1
End DoDot:1
+4 IF '$TEST
XECUTE SPECIAL(308)
+5 QUIT
308FMT IF ABSP("X")'=""
SET ABSP("X")="C8"_$$NFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
308SET DO FLD308^ABSPOSSG
+1 QUIT
+2 ;Unit Dose Indicator
429GET IF '$DATA(SPECIAL(429))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Unit Dose Indicator"))
+1 IF '$TEST
XECUTE SPECIAL(429)
+2 QUIT
429FMT IF ABSP("X")'=""
SET ABSP("X")="DT"_$$NFF^ABSPECFM($GET(ABSP("X")),1)
+1 QUIT
429SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,29)=ABSP("X")
+1 QUIT
+2 ;Orig Presc Prod/Serv ID Qual
453GET IF '$DATA(SPECIAL(453))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Orig Pres Prod Qual"))
+1 IF '$TEST
XECUTE SPECIAL(453)
+2 QUIT
453FMT IF ABSP("X")'=""
SET ABSP("X")="EJ"_$$ANFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
453SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,3)=ABSP("X")
+1 QUIT
+2 ;Orig Presc Prod/Serv Code
445GET IF '$DATA(SPECIAL(445))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Orig Pres Prod"))
+1 IF '$TEST
XECUTE SPECIAL(445)
+2 QUIT
445FMT IF ABSP("X")'=""
SET ABSP("X")="EA"_$$ANFF^ABSPECFM(ABSP("X"),19)
+1 QUIT
445SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,5)=ABSP("X")
+1 QUIT
+2 ;Originally Prescribed Quantity
446GET IF '$DATA(SPECIAL(446))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Org Pres Qty"))
+1 IF '$TEST
XECUTE SPECIAL(446)
+2 QUIT
446FMT ;Spec says length is 7?
IF ABSP("X")'=""
SET ABSP("X")="EB"_$$NFF^ABSPECFM(ABSP("X"),10)
+1 QUIT
446SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),440),U,6)=ABSP("X")
+1 QUIT
+2 ;Alternate ID
330GET IF '$DATA(SPECIAL(330))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Alternate ID"))
+1 IF '$TEST
XECUTE SPECIAL(330)
+2 QUIT
330FMT IF ABSP("X")'=""
SET ABSP("X")="CW"_$$ANFF^ABSPECFM(ABSP("X"),20)
+1 QUIT
330SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),320),U,10)=ABSP("X")
+1 QUIT
+2 ;Scheduled Pres ID Number
454GET IF '$DATA(SPECIAL(454))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Schd Pres ID Num"))
+1 IF '$TEST
XECUTE SPECIAL(454)
+2 QUIT
454FMT IF ABSP("X")'=""
SET ABSP("X")="EK"_$$ANFF^ABSPECFM(ABSP("X"),12)
+1 QUIT
454SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,4)=ABSP("X")
+1 QUIT
+2 ;Unit of measure
600GET IF '$DATA(SPECIAL(600))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Unit of Measure"))
+1 IF '$TEST
XECUTE SPECIAL(600)
+2 QUIT
600FMT IF ABSP("X")'=""
SET ABSP("X")="28"_$$ANFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
600SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),600),U,1)=ABSP("X")
+1 QUIT
+2 ;Level of Service
418GET IF '$DATA(SPECIAL(418))
SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Level of Service"))
+1 IF '$TEST
XECUTE SPECIAL(418)
+2 QUIT
418FMT IF ABSP("X")'=""
SET ABSP("X")="DI"_$$NFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
418SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,18)=ABSP("X")
+1 QUIT
+2 ;Prior Authorization Type Code
461GET IF '$DATA(SPECIAL(461))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Prior Auth Type"))
+1 IF '$TEST
XECUTE SPECIAL(461)
+2 QUIT
461FMT IF ABSP("X")'=""
SET ABSP("X")="EU"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
461SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,1)=ABSP("X")
+1 QUIT
+2 ;Prior Authorization Num Sub
462GET IF '$DATA(SPECIAL(462))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Prior Auth Num Sub"))
+1 IF '$TEST
XECUTE SPECIAL(462)
+2 QUIT
462FMT IF ABSP("X")'=""
SET ABSP("X")="EV"_$$NFF^ABSPECFM(ABSP("X"),11)
+1 QUIT
462SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,2)=ABSP("X")
+1 QUIT
+2 ;Intermediary Auth Type ID
463GET IF '$DATA(SPECIAL(463))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Inter Auth Type"))
+1 IF '$TEST
XECUTE SPECIAL(463)
+2 QUIT
463FMT IF ABSP("X")'=""
SET ABSP("X")="EW"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
463SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,3)=ABSP("X")
+1 QUIT
+2 ;Intermediary Auth ID
464GET IF '$DATA(SPECIAL(464))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Inter Auth"))
+1 IF '$TEST
XECUTE SPECIAL(464)
+2 QUIT
464FMT IF ABSP("X")'=""
SET ABSP("X")="EX"_$$ANFF^ABSPECFM(ABSP("X"),11)
+1 QUIT
464SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),460),U,4)=ABSP("X")
+1 QUIT
+2 ;Dispensing Status
343GET IF '$DATA(SPECIAL(343))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Dispensing Status"))
+1 IF '$TEST
XECUTE SPECIAL(343)
+2 QUIT
343FMT IF ABSP("X")'=""
SET ABSP("X")="HD"_$$ANFF^ABSPECFM(ABSP("X"),1)
+1 QUIT
343SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),340),U,3)=ABSP("X")
+1 QUIT
+2 ;Qty intended to be dispensed
344GET IF '$DATA(SPECIAL(344))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Qty Intd Dispd"))
+1 IF '$TEST
XECUTE SPECIAL(344)
+2 QUIT
344FMT ;Spec says length is 7?
IF ABSP("X")'=""
SET ABSP("X")="HF"_$$NFF^ABSPECFM(ABSP("X"),10)
+1 QUIT
344SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),340),U,4)=ABSP("X")
+1 QUIT
+2 ;Day Supply Intd Dispensed
345GET IF '$DATA(SPECIAL(345))
SET ABSP("X")=$GET(ABSP("Claim",ABSP(9002313.0201),"Days Sup Intd Dispd"))
+1 IF '$TEST
XECUTE SPECIAL(345)
+2 QUIT
345FMT IF ABSP("X")'=""
SET ABSP("X")="HG"_$$NFF^ABSPECFM(ABSP("X"),3)
+1 QUIT
345SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),340),U,5)=ABSP("X")
+1 QUIT
APPEND(FIELD) ;This is where the 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 QUIT
