- 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