ABSPDB2A ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of NCPDP Reversal "B2" Claims for D.0 (Claim Segment)
;;1.0;PHARMACY POINT OF SALE;**42,47**;JUN 21, 2001;Build 38
;
CLAIM ;EP CALLED FROM ABSPDB2 to set up CLAIM SEGMENT
N FIELD
S RECORD=$G(RECORD)
F FIELD="111",455,402,436,407,403,308,147 D
. Q:$D(SUPPRESS(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 and Reversal Transactions
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
;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
;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
;Pharmacy Service Type
147GET I '$D(SPECIAL(147)) S ABSP("X")="01" ;OIT/CAS/RCS Add default value
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
;
PRICING ;EP CALLED FROM ABSPDB2 to set up PRICING SEGMENT
N FIELD
S RECORD=$G(RECORD)
F FIELD="111A",438,430 D
. Q:$D(SUPPRESS(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")=11
Q
111AFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
Q
111ASET ;This isn't used for the 111 Field
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
;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
;
DURRPPS ;EP CALLED FROM ABSPB1 to set up DURR/PPS SEGMENT
N FIELD
S RECORD=$G(RECORD)
F FIELD="111B",473,439,440,441,474 D
. Q:$D(SUPPRESS(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")="08"
Q
111BFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
Q
111BSET ;This isn't used for the 111 Field
Q
;DUR/PPS Code Counter
473GET I '$D(SPECIAL(473)) S ABSP("X")=""
ELSE X SPECIAL(473)
Q
473FMT S:ABSP("X")'="" ABSP("X")="7E"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
473SET D FLD473^ABSPOSSG
Q
;Reason for Service Code
439GET I '$D(SPECIAL(439)) S ABSP("X")=""
ELSE X SPECIAL(439)
Q
439FMT S:ABSP("X")'="" ABSP("X")="E4"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
439SET D FLD439^ABSPOSSG
Q
;Professional Service Code
440GET I '$D(SPECIAL(440)) S ABSP("X")=""
ELSE X SPECIAL(440)
Q
440FMT S:ABSP("X")'="" ABSP("X")="E5"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
440SET D FLD440^ABSPOSSG
Q
;Result of Service Coce
441GET I '$D(SPECIAL(441)) S ABSP("X")=""
ELSE X SPECIAL(441)
Q
441FMT S:ABSP("X")'="" ABSP("X")="E6"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
441SET D FLD441^ABSPOSSG
Q
;DUR/PPS Level of Effort
474GET I '$D(SPECIAL(474)) S ABSP("X")=""
ELSE X SPECIAL(474)
Q
474FMT S:ABSP("X")'="" ABSP("X")="8E"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
Q
474SET D FLD474^ABSPOSSG
Q
;
APPEND(FIELD) ;This is where the outgoing record is created field by field
I FIELD["111" D
. D @(FIELD_"GET")
. D @(FIELD_"FMT")
. S RECORD=RECORD_$C(29,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
ABSPDB2A ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of NCPDP Reversal "B2" Claims for D.0 (Claim Segment)
+1 ;;1.0;PHARMACY POINT OF SALE;**42,47**;JUN 21, 2001;Build 38
+2 ;
CLAIM ;EP CALLED FROM ABSPDB2 to set up CLAIM SEGMENT
+1 NEW FIELD
+2 SET RECORD=$GET(RECORD)
+3 FOR FIELD="111",455,402,436,407,403,308,147
Begin DoDot:1
+4 IF $DATA(SUPPRESS(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 and Reversal Transactions
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 ;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 ;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 ;Pharmacy Service Type
147GET ;OIT/CAS/RCS Add default value
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
+2 ;
PRICING ;EP CALLED FROM ABSPDB2 to set up PRICING SEGMENT
+1 NEW FIELD
+2 SET RECORD=$GET(RECORD)
+3 FOR FIELD="111A",438,430
Begin DoDot:1
+4 IF $DATA(SUPPRESS(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
111AGET SET ABSP("X")=11
+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 ;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 ;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 ;
DURRPPS ;EP CALLED FROM ABSPB1 to set up DURR/PPS SEGMENT
+1 NEW FIELD
+2 SET RECORD=$GET(RECORD)
+3 FOR FIELD="111B",473,439,440,441,474
Begin DoDot:1
+4 IF $DATA(SUPPRESS(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")="08"
+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 ;DUR/PPS Code Counter
473GET IF '$DATA(SPECIAL(473))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(473)
+2 QUIT
473FMT IF ABSP("X")'=""
SET ABSP("X")="7E"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
473SET DO FLD473^ABSPOSSG
+1 QUIT
+2 ;Reason for Service Code
439GET IF '$DATA(SPECIAL(439))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(439)
+2 QUIT
439FMT IF ABSP("X")'=""
SET ABSP("X")="E4"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
439SET DO FLD439^ABSPOSSG
+1 QUIT
+2 ;Professional Service Code
440GET IF '$DATA(SPECIAL(440))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(440)
+2 QUIT
440FMT IF ABSP("X")'=""
SET ABSP("X")="E5"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
440SET DO FLD440^ABSPOSSG
+1 QUIT
+2 ;Result of Service Coce
441GET IF '$DATA(SPECIAL(441))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(441)
+2 QUIT
441FMT IF ABSP("X")'=""
SET ABSP("X")="E6"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
441SET DO FLD441^ABSPOSSG
+1 QUIT
+2 ;DUR/PPS Level of Effort
474GET IF '$DATA(SPECIAL(474))
SET ABSP("X")=""
+1 IF '$TEST
XECUTE SPECIAL(474)
+2 QUIT
474FMT IF ABSP("X")'=""
SET ABSP("X")="8E"_$$ANFF^ABSPECFM($GET(ABSP("X")),2)
+1 QUIT
474SET DO FLD474^ABSPOSSG
+1 QUIT
+2 ;
APPEND(FIELD) ;This is where the outgoing record is created field by field
+1 IF FIELD["111"
Begin DoDot:1
+2 DO @(FIELD_"GET")
+3 DO @(FIELD_"FMT")
+4 SET RECORD=RECORD_$CHAR(29,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
