ABSPDB1A ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (Claim Segment)
;;1.0;PHARMACY POINT OF SALE;**42,46**;JUN 21, 2001;Build 38
;
CLAIM ;EP CALLED FROM ABSPDB1 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,354,42001,42002,42003,308,429,453,445,446,454,600,418,461,462,463,464,343,344,345,357,391,995,996,147 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")=1 ;In D.0 Value is always 1 on Billing Transaction
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"))>12 S ABSP("X")=$E(ABSP("X"),$L(ABSP("X"))-11,$L(ABSP("X")))
S:ABSP("X")'="" ABSP("X")="D2"_$$NFF^ABSPECFM($G(ABSP("X")),12)
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"),12)
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"),2)
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 Count
354GET S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Subm Clar Count"))
Q
354FMT S:ABSP("X")'="" ABSP("X")="NX"_$$NFF^ABSPECFM($G(ABSP("X")),1)
Q
354SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),350),U,4)=ABSP("X")
Q
;Submission Clarification Code 1
42001GET S ABSP("X")="" I $G(ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 1"))]"" S ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 1")
Q
42001FMT S:ABSP("X")'="" ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
42001SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),421),U,1)=ABSP("X")
Q
;Submission Clarification Code 2
42002GET S ABSP("X")="" I $G(ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 2"))]"" S ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 2")
Q
42002FMT S:ABSP("X")'="" ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
42002SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),421),U,2)=ABSP("X")
Q
;Submission Clarification Code 1
42003GET S ABSP("X")="" I $G(ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 3"))]"" S ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 3")
Q
42003FMT S:ABSP("X")'="" ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
Q
42003SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),421),U,3)=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
;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
;Delay Reason Code
357GET I '$D(SPECIAL(357)) S ABSP("X")=""
ELSE X SPECIAL(357)
Q
357FMT S:ABSP("X")'="" ABSP("X")="NV"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
357SET ;Not Yet Implemented
Q
;Patient Assignment Indicator
391GET I '$D(SPECIAL(391)) S ABSP("X")=""
ELSE X SPECIAL(391)
Q
391FMT S:ABSP("X")'="" ABSP("X")="MT"_$$ANFF^ABSPECFM($G(ABSP("X")),1)
Q
391SET ;Not Yet Implemented
Q
;Route of Administration
995GET I '$D(SPECIAL(995)) S ABSP("X")=""
ELSE X SPECIAL(995)
Q
995FMT S:ABSP("X")'="" ABSP("X")="E2"_$$ANFF^ABSPECFM($G(ABSP("X")),11)
Q
995SET ;Not Yet Implemented
Q
;Compound Type
996GET I '$D(SPECIAL(996)) S ABSP("X")=""
ELSE X SPECIAL(996)
Q
996FMT S:ABSP("X")'="" ABSP("X")="G1"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
996SET ;Not Yet Implemented
Q
;Pharmacy Service Type
147GET I '$D(SPECIAL(147)) S ABSP("X")="01"
ELSE X SPECIAL(147)
Q
147FMT S:ABSP("X")'="" ABSP("X")="U7"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
147SET S $P(^ABSPC(ABSP(9002313.02),140),U,7)=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 $E(FIELD,1,3)=420 S FIELD="420."_$E(FIELD,5)
. 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
ABSPDB1A ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of outgoing NCPDP Billing "B1" Claims for D.0 (Claim Segment)
+1 ;;1.0;PHARMACY POINT OF SALE;**42,46**;JUN 21, 2001;Build 38
+2 ;
CLAIM ;EP CALLED FROM ABSPDB1 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,354,42001,42002,42003,308,429,453,445,446,454,600,418,461,462,463,464,343,344,345,357,391,995,996,147
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 ;In D.0 Value is always 1 on Billing Transaction
IF '$DATA(SPECIAL(455))
SET ABSP("X")=1
+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"))>12
SET ABSP("X")=$EXTRACT(ABSP("X"),$LENGTH(ABSP("X"))-11,$LENGTH(ABSP("X")))
+1 IF ABSP("X")'=""
SET ABSP("X")="D2"_$$NFF^ABSPECFM($GET(ABSP("X")),12)
+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"),12)
+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"),2)
+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 Count
354GET SET ABSP("X")=$GET(ABSP("RX",ABSP(9002313.0201),"Subm Clar Count"))
+1 QUIT
354FMT IF ABSP("X")'=""
SET ABSP("X")="NX"_$$NFF^ABSPECFM($GET(ABSP("X")),1)
+1 QUIT
354SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),350),U,4)=ABSP("X")
+1 QUIT
+2 ;Submission Clarification Code 1
42001GET SET ABSP("X")=""
IF $GET(ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 1"))]""
SET ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 1")
+1 QUIT
42001FMT IF ABSP("X")'=""
SET ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
42001SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),421),U,1)=ABSP("X")
+1 QUIT
+2 ;Submission Clarification Code 2
42002GET SET ABSP("X")=""
IF $GET(ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 2"))]""
SET ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 2")
+1 QUIT
42002FMT IF ABSP("X")'=""
SET ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
42002SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),421),U,2)=ABSP("X")
+1 QUIT
+2 ;Submission Clarification Code 1
42003GET SET ABSP("X")=""
IF $GET(ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 3"))]""
SET ABSP("X")=ABSP("RX",ABSP(9002313.0201),"Subm Clar Code 3")
+1 QUIT
42003FMT IF ABSP("X")'=""
SET ABSP("X")="DK"_$$NFF^ABSPECFM(ABSP("X"),2)
+1 QUIT
42003SET SET $PIECE(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),421),U,3)=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 ;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
+2 ;Delay Reason Code
357GET IF '$DATA(SPECIAL(357))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(357)
+2 QUIT
357FMT IF ABSP("X")'=""
SET ABSP("X")="NV"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
357SET ;Not Yet Implemented
+1 QUIT
+2 ;Patient Assignment Indicator
391GET IF '$DATA(SPECIAL(391))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(391)
+2 QUIT
391FMT IF ABSP("X")'=""
SET ABSP("X")="MT"_$$ANFF^ABSPECFM($GET(ABSP("X")),1)
+1 QUIT
391SET ;Not Yet Implemented
+1 QUIT
+2 ;Route of Administration
995GET IF '$DATA(SPECIAL(995))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(995)
+2 QUIT
995FMT IF ABSP("X")'=""
SET ABSP("X")="E2"_$$ANFF^ABSPECFM($GET(ABSP("X")),11)
+1 QUIT
995SET ;Not Yet Implemented
+1 QUIT
+2 ;Compound Type
996GET IF '$DATA(SPECIAL(996))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(996)
+2 QUIT
996FMT IF ABSP("X")'=""
SET ABSP("X")="G1"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
996SET ;Not Yet Implemented
+1 QUIT
+2 ;Pharmacy Service Type
147GET IF '$DATA(SPECIAL(147))
SET ABSP("X")="01"
+1 IF '$TEST
XECUTE SPECIAL(147)
+2 QUIT
147FMT IF ABSP("X")'=""
SET ABSP("X")="U7"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
147SET SET $PIECE(^ABSPC(ABSP(9002313.02),140),U,7)=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 $EXTRACT(FIELD,1,3)=420
SET FIELD="420."_$EXTRACT(FIELD,5)
+7 IF $GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'=""
SET RECORD=RECORD_$CHAR(28)_$GET(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))
+8 IF '$TEST
IF $DATA(SPECIAL(FIELD))
Begin DoDot:2
+9 XECUTE SPECIAL(FIELD)
+10 DO @(FIELD_"FMT")
+11 SET RECORD=RECORD_$CHAR(28)_ABSP("X")
End DoDot:2
End DoDot:1
+12 QUIT
