Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSP5B2A

ABSP5B2A.m

Go to the documentation of this file.
  1. ABSP5B2A ; IHS/OIT/CASSevern/Pieran ran 1/19/2011 - Handling of NCPDP Reversal "B2" Claims for 5.1 (Claim Segment)
  1. ;;1.0;PHARMACY POINT OF SALE;**42**;JUN 21, 2001;Build 38
  1. ;
  1. CLAIM ;EP CALLED FROM ABSP5B2 to set up CLAIM SEGMENT
  1. N FIELD
  1. S RECORD=$G(RECORD)
  1. F FIELD="111",455,402,436,407,403,308,147 D
  1. . Q:$D(SUPPRESS(FIELD))
  1. . I (ACTION["CLAIM"),(FIELD'=111) D
  1. . . D @(FIELD_"GET")
  1. . . D @(FIELD_"FMT")
  1. . . D @(FIELD_"SET")
  1. . ELSE D APPEND(FIELD)
  1. Q
  1. ;Segment identifier
  1. 111GET S ABSP("X")="07"
  1. Q
  1. 111FMT S:ABSP("X")'="" ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 111SET ;This isn't used for the 111 Field
  1. Q
  1. ;Presc Srv Ref Qualifier
  1. 455GET I '$D(SPECIAL(455)) S ABSP("X")=1 ;In 5.1 Value is always 1 on Billing and Reversal Transactions
  1. ELSE X SPECIAL(455)
  1. Q
  1. 455FMT S:ABSP("X")'="" ABSP("X")="EM"_$$ANFF^ABSPECFM(ABSP("X"),1)
  1. Q
  1. 455SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),450),U,5)=ABSP("X")
  1. Q
  1. ;Presc Srv Ref Number
  1. 402GET I '$D(SPECIAL(402)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"RX Number"))
  1. ELSE X SPECIAL(402)
  1. Q
  1. 402FMT I $L(ABSP("X"))>12 S ABSP("X")=$E(ABSP("X"),$L(ABSP("X"))-11,$L(ABSP("X")))
  1. S:ABSP("X")'="" ABSP("X")="D2"_$$NFF^ABSPECFM($G(ABSP("X")),12)
  1. Q
  1. 402SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,2)=ABSP("X")
  1. Q
  1. ;Product Serv ID Qualifer
  1. 436GET I '$D(SPECIAL(436)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Alt. Product Type"))
  1. ELSE X SPECIAL(436)
  1. Q
  1. 436FMT S:ABSP("X")'="" ABSP("X")="E1"_$$ANFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 436SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,6)=ABSP("X")
  1. Q
  1. ;Product Serv ID
  1. 407GET I '$D(SPECIAL(407)) D
  1. . S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"NDC"))
  1. . S ABSP("X")=$$NDCF^ABSPECFM(ABSP("X"))
  1. ELSE X SPECIAL(407)
  1. Q
  1. 407FMT S:ABSP("X")'="" ABSP("X")="D7"_$$ANFF^ABSPECFM(ABSP("X"),$L(ABSP("X"))) ;Spec says length is 19?
  1. Q
  1. 407SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,7)=ABSP("X")
  1. Q
  1. ;Fill Number
  1. 403GET I '$D(SPECIAL(403)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Refill #"))
  1. ELSE X SPECIAL(403)
  1. Q
  1. 403FMT S:ABSP("X")'="" ABSP("X")="D3"_$$NFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 403SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,3)=ABSP("X")
  1. Q
  1. ;Other Coverage Code
  1. 308GET I '$D(SPECIAL(308)) D
  1. . S ABSP("X")=$G(ABSP("Patient","Other Coverage Code"))
  1. . S:$G(ABSP(9002313.0201))'="" ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"CC"))
  1. . S:'ABSP("X") ABSP("X")=1
  1. ELSE X SPECIAL(308)
  1. Q
  1. 308FMT S:ABSP("X")'="" ABSP("X")="C8"_$$NFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 308SET D FLD308^ABSPOSSG
  1. Q
  1. ;Pharmacy Service Type
  1. 147GET I '$D(SPECIAL(147)) S ABSP("X")=""
  1. ELSE X SPECIAL(147)
  1. Q
  1. 147FMT S:ABSP("X")'="" ABSP("X")="U7"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 147SET ;Not Yet Implemented
  1. Q
  1. ;
  1. PRICING ;EP CALLED FROM ABSP5B2 to set up PRICING SEGMENT
  1. N FIELD
  1. S RECORD=$G(RECORD)
  1. F FIELD="111A",438,430 D
  1. . Q:$D(SUPPRESS(FIELD))
  1. . I (ACTION["CLAIM"),(FIELD'=111) D
  1. . . D @(FIELD_"GET")
  1. . . D @(FIELD_"FMT")
  1. . . D @(FIELD_"SET")
  1. . ELSE D APPEND(FIELD)
  1. Q
  1. ;Segment identifier
  1. 111AGET S ABSP("X")=11
  1. Q
  1. 111AFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 111ASET ;This isn't used for the 111 Field
  1. Q
  1. ;Incentive Amount
  1. 438GET I '$D(SPECIAL(438)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Incentive Amount"))
  1. ELSE X SPECIAL(438)
  1. Q
  1. 438FMT S:ABSP("X")'="" ABSP("X")="E3"_$$DFF^ABSPECFM($G(ABSP("X")),8)
  1. Q
  1. 438SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),430),U,8)=ABSP("X")
  1. Q
  1. ;Gross Amnt Due
  1. 430GET I '$D(SPECIAL(430)) S ABSP("X")=$G(ABSP("RX",ABSP(9002313.0201),"Gross Amount Due"))
  1. ELSE X SPECIAL(430)
  1. Q
  1. 430FMT S:ABSP("X")'="" ABSP("X")="DU"_$$DFF^ABSPECFM($G(ABSP("X")),8)
  1. Q
  1. 430SET S $P(^ABSPC(ABSP(9002313.02),400,ABSP(9002313.0201),400),U,30)=ABSP("X")
  1. Q
  1. ;
  1. DURRPPS ;EP CALLED FROM ABSPB1 to set up DURR/PPS SEGMENT
  1. N FIELD
  1. S RECORD=$G(RECORD)
  1. F FIELD="111B",473,439,440,441,474 D
  1. . Q:$D(SUPPRESS(FIELD))
  1. . I (ACTION["CLAIM"),(FIELD'=111) D
  1. . . D @(FIELD_"GET")
  1. . . D @(FIELD_"FMT")
  1. . . D @(FIELD_"SET")
  1. . ELSE D APPEND(FIELD)
  1. Q
  1. ;Segment identifier
  1. 111BGET S ABSP("X")="08"
  1. Q
  1. 111BFMT S ABSP("X")=$$ANFF^ABSPECFM(ABSP("X"),2)
  1. Q
  1. 111BSET ;This isn't used for the 111 Field
  1. Q
  1. ;DUR/PPS Code Counter
  1. 473GET I '$D(SPECIAL(473)) S ABSP("X")=""
  1. ELSE X SPECIAL(473)
  1. Q
  1. 473FMT S:ABSP("X")'="" ABSP("X")="7E"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 473SET D FLD473^ABSPOSSG
  1. Q
  1. ;Reason for Service Code
  1. 439GET I '$D(SPECIAL(439)) S ABSP("X")=""
  1. ELSE X SPECIAL(439)
  1. Q
  1. 439FMT S:ABSP("X")'="" ABSP("X")="E4"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 439SET D FLD439^ABSPOSSG
  1. Q
  1. ;Professional Service Code
  1. 440GET I '$D(SPECIAL(440)) S ABSP("X")=""
  1. ELSE X SPECIAL(440)
  1. Q
  1. 440FMT S:ABSP("X")'="" ABSP("X")="E5"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 440SET D FLD440^ABSPOSSG
  1. Q
  1. ;Result of Service Coce
  1. 441GET I '$D(SPECIAL(441)) S ABSP("X")=""
  1. ELSE X SPECIAL(441)
  1. Q
  1. 441FMT S:ABSP("X")'="" ABSP("X")="E6"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 441SET D FLD441^ABSPOSSG
  1. Q
  1. ;DUR/PPS Level of Effort
  1. 474GET I '$D(SPECIAL(474)) S ABSP("X")=""
  1. ELSE X SPECIAL(474)
  1. Q
  1. 474FMT S:ABSP("X")'="" ABSP("X")="8E"_$$ANFF^ABSPECFM($G(ABSP("X")),2)
  1. Q
  1. 474SET D FLD474^ABSPOSSG
  1. Q
  1. ;
  1. APPEND(FIELD) ;This is where the outgoing record is built field by field
  1. I FIELD["111" D
  1. . D @(FIELD_"GET")
  1. . D @(FIELD_"FMT")
  1. . S RECORD=RECORD_$C(30,28)_"AM"_ABSP("X")
  1. ELSE D
  1. . I $G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))'="" S RECORD=RECORD_$C(28)_$G(ABSP(9002313.0201,IEN(9002313.01),FIELD,"I"))
  1. . ELSE I $D(SPECIAL(FIELD)) D
  1. . . X SPECIAL(FIELD)
  1. . . D @(FIELD_"FMT")
  1. . . S RECORD=RECORD_$C(28)_ABSP("X")
  1. Q