BPSOSH2 ;BHAM ISC/SD/lwj/DLF - Assemble formatted claim ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10,15,19,20,23,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
; 5.1 had 14 claim segments (Header, Patient, Insurance, Claim
; Pharmacy Provider, Prescriber,
; COB, Workers Comp, DUR, Pricing,
; Coupon, Compound, Prior Auth,
; Clinical)
;
; D.0 added 3 new request segments (Additional Documentation,
; Facility, Narrative)
;
; D.1 - D.9 introduces Alphanumeric NCPDP numbers and new
; Purchase and Provider segments
;
; E.0 - E.6 added 2 new request segments (Intermediary, Last
; Known 4RX)
;
; 5.1/D.0 requires field identifiers and separators on all fields
; other than the header
; 5.1/D.0 segment separators are required prior to each segment
; following the header
; 5.1/D.0 group separators appear at the end of each
; transaction (prescription)
; 5.1/D.0 only want to send segments that have data - a new
; segment record will hold the data until we are sure
; we have something to send
;
; Put together ASCII formatted record per the Payer Sheet Definition
; Input:
; NODES - "100^110^120" or "130^140^150^160^170^180^190^200^210^220^230^240^250^260^270^280^290^300"
; Passed by Ref:
; .IEN - Internal Entry Number array
; .BPS - Formatted Data Array with claim and transaction data
; .REC - Formatted ASCII record (result)
;
XLOOP(NODES,IEN,BPS,REC) ;EP - from BPSECA1
;
N DATAFND,FDATA,FLAG,FLDDATA,FLDID,FLDIEN,FLDNUM,IEN511,IEN59,INDEX,MDATA,NODE,NODEIEN,ORDER,PMODE,RECMIEN,SEGREC
N VER,TYPE,BPSX
;
; Get payer sheet version and transaction type
S VER=$P($G(^BPSF(9002313.92,+$G(IEN(9002313.92)),1)),U,2)
S TYPE=$G(BPS(9002313.02,+$G(IEN(9002313.02)),103,"I"))
;
; Loop through the NODES variable delimited by U
F INDEX=1:1:$L(NODES,U) D
. S NODE=$P(NODES,U,INDEX) Q:NODE=""
. ;
. ; VA does not support these segments
. Q:",300,290,280,270,260,250,240,230,220,210,200,170,140,"[NODE
. ;
. ; Quit if the payer sheet does not have the node
. Q:'$D(^BPSF(9002313.92,+IEN(9002313.92),NODE,0))
. ;
. ; Per NCPDP standard, reversals do not support segments listed below
. I TYPE="B2",",300,290,280,270,260,250,240,230,220,210,200,170,150,140,"[NODE Q
. I TYPE="B2",VER="D0",NODE=110 Q ;Patient segment not supported in a D0 reversal
. ;
. ; Per NCPDP standard, eligibility does not support segments listed below
. I TYPE="E1",",290,280,270,260,250,230,220,210,200,190,180,170,160,130,"[NODE Q
. ;
. S DATAFND=0 ; indicates if data is on the segment for us to send
. S SEGREC="" ; segment's information
. ;
. D:NODE=180 PROCDUR
. ;
. ;COB fields
. D:NODE=160 PROCCOB
. ;
. S ORDER=""
. F D Q:'ORDER
.. ;
.. Q:NODE=180 ; DUR/PPS section (repeating), already processed
.. Q:NODE=160 ; COB data processed earlier
.. S ORDER=$O(^BPSF(9002313.92,+IEN(9002313.92),NODE,"B",ORDER))
.. Q:'ORDER
.. S RECMIEN=""
.. S RECMIEN=$O(^BPSF(9002313.92,+IEN(9002313.92),NODE,"B",ORDER,RECMIEN))
.. Q:RECMIEN=""
.. ;
.. S MDATA=$G(^BPSF(9002313.92,+IEN(9002313.92),NODE,RECMIEN,0))
.. Q:MDATA=""
.. ;
.. S FLDIEN=$P(MDATA,U,2)
.. Q:FLDIEN=""
.. ;
.. S FDATA=$G(^BPSF(9002313.91,FLDIEN,0))
.. Q:FDATA=""
.. S FLDNUM=$P(FDATA,U,1)
.. Q:FLDNUM=""
.. ;Check for alphanumeric NCPDP numbers - BPS*1*15
.. I $P(FLDNUM,".")'?3N S FLDNUM=$$VNUM^BPSECMPS(FLDNUM) Q:'FLDNUM
.. ;
.. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID
.. ;
.. ;header data
.. S:NODE<130 FLDDATA=$G(BPS(9002313.02,IEN(9002313.02),FLDNUM,"I"))
.. ;
.. ;transaction data
.. S:NODE>120 FLDDATA=$G(BPS(9002313.0201,IEN(9002313.0201),FLDNUM,"I"))
.. I $TR($E(FLDDATA,3,999),"0 {}")'="" S DATAFND=1 ;BPS*1*15 - allow for zero in NCPDP ID
.. ;
.. ;check if this is the seg id - call this after fld chk since
.. ;we don't want to send the segment if this is all there is
.. I (NODE>100)&(FLDNUM=111) S FLDDATA=$$SEGID(NODE)
.. ;
.. ; Special code to handle the Submission Clarification Code (420) repeating group
.. I FLDNUM=420 D SUBCLAR(.DATAFND,.IEN,.SEGREC) Q
.. ;
.. ; Special code to handle the Other Amount Claimed repeating group
.. I FLDNUM=480 D OAMTCLMD(.DATAFND,.IEN,.SEGREC) Q
.. I FLDNUM=479 Q ; fields 479 & 480 handled as a pair in OAMTCLMD
.. ;
.. Q:FLDDATA="" ;lje;7/23/03; don't want extra field separators when field is blank for testing for WebMD.
.. ;
.. S:NODE=100 SEGREC=SEGREC_FLDDATA ;no FS on the header rec
.. S:NODE>100 SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
. ;
. ; If the current segment is 130/Claim (B1 - Billing Requests only),
. ; add field 460-ET QUANTITY PRESCRIBED if data exists and it's not
. ; already populated.
. ;
. I NODE=130,TYPE="B1" D
.. ; Check to see if 460-ET already added to segment.
.. I SEGREC[($C(28)_"ET") Q
.. S FLDDATA=BPS(9002313.0201,IEN(9002313.0201),460,"I")
.. I FLDDATA'="" S SEGREC=SEGREC_$C(28)_FLDDATA
.. Q
. ;
. ; If no data on this segment, Quit, don't check for addl. fields.
. ;
. I 'DATAFND Q
. ;
. ; The user has the ability, via the action RED / Resubmit with
. ; Edits, to add claim fields not on the payer sheet. Any
. ; fields to be added to the claim are stored in the file BPS NCPDP
. ; OVERRIDE. Pull the BPS TRANSACTION from the BPS CLAIMS file,
. ; then pull the field NCPDP OVERRIDES. If populated, pull any
. ; additional fields.
. ;
. S IEN59=$$GET1^DIQ(9002313.02,IEN(9002313.02),.08,"I")
. S IEN511=$$GET1^DIQ(9002313.59,IEN59,1.13,"I")
. I IEN511 D
. . ;
. . ; Loop through additional fields for the current segment
. . ; (NODE) and add to the claim.
. . ;
. . S NODEIEN=$O(^BPSF(9002313.9,"C",NODE,""))
. . I 'NODEIEN Q
. . S BPSX=""
. . F S BPSX=$O(^BPS(9002313.511,IEN511,2,"SEG",NODEIEN,BPSX)) Q:BPSX="" D
. . . S FLDIEN=$$GET1^DIQ(9002313.5112,BPSX_","_IEN511_",",.01,"I")
. . . ;
. . . ; The data in the BPS array is stored according to the number
. . . ; of each field in BPS CLAIMS. That number corresponds to the
. . . ; NCPDP field number when the NCPDP number is all numeric. For
. . . ; alphanumeric field numbers, such as "B95", we must call
. . . ; $$VNUM^BPSECMPS to pull the BPS CLAIMS field number from BPS
. . . ; NCPDP FIELD DEFS.
. . . ;
. . . S FLDNUM=$$GET1^DIQ(9002313.91,FLDIEN,.01,"E")
. . . I FLDNUM="" Q
. . . I $P(FLDNUM,".")'?3N S FLDNUM=$$VNUM^BPSECMPS(FLDNUM) I 'FLDNUM Q
. . . ;
. . . I NODE<130 S FLDDATA=$G(BPS(9002313.02,IEN(9002313.02),FLDNUM,"I"))
. . . I NODE>120 S FLDDATA=$G(BPS(9002313.0201,IEN(9002313.0201),FLDNUM,"I"))
. . . ;
. . . I FLDDATA="" Q
. . . ;
. . . ; $C(28) = File Separator. On all segments except the Header,
. . . ; FS precedes each field.
. . . ;
. . . I NODE=100 S SEGREC=SEGREC_FLDDATA
. . . I NODE>100 S SEGREC=SEGREC_$C(28)_FLDDATA
. . . ;
. . . Q
. . Q
. ;
. I NODE=100 S REC(NODE)=SEGREC ;no SS when it's the header
. I NODE>100 D
.. I '$D(REC(NODE)) S REC(NODE)=REC I REC[$C(29) S REC=""
.. S REC(NODE)=REC(NODE)_$C(30)_SEGREC ;SS before the seg
;
Q
;
SEGID(ND) ; function, returns Segment ID
; Field 111 is the Segment Identifier - for each segment, other than
; the header, a unique value must be sent in this field
; to identify which segment is being sent. This value is not stored
; in the claim - as it changes with each of the 20 segments. The
; field does appear as part of the NCPDP Format, but is simply not stored.
; 01 = Patient 02 = Pharmacy Provider 03 = Prescriber
; 04 = Insurance 05 = COB/Other Payment 06 = Workers' Comp
; 07 = Claim 08 = DUR/PPS 09 = Coupon
; 10 = Compound 11 = Pricing 12 = Prior Auth
; 13 = Clinical 14 = Additional Doc 15 = Facility
; 16 = Narrative 17 = Purchaser 18 = Service Provider
; 19 = Intermediary 37 = Last Known 4Rx
;
N FLD
;
S FLD=$S(ND=110:"01",ND=120:"04",ND=130:"07",ND=140:"02",ND=150:"03",ND=160:"05",ND=170:"06",ND=180:"08",ND=190:11,ND=200:"09",ND=210:10,ND=220:12,ND=230:13,ND=240:14,ND=250:15,ND=260:16,ND=270:17,ND=280:18,ND=290:19,ND=300:37,1:"00")
S FLD="AM"_$$NFF^BPSECFM(FLD,2)
;
Q FLD
;
PROCDUR ; The DUR/PPS segment can repeat itself for any given
; transaction within a claim. This means we have to have special
; programming to handle the repeating fields.
;
; Input Data
; BPS array - Set in BPSOSC* routines
; IEN array - Contain IEN information for the BPS NCPDP FORMAT file
; NODE - Multiple of the BPS NCPDP FORMAT file
; Input/Output Data
; SEGREC - This is data for the segment being created
; DATAFND - Flag indicating if there is legitimate data for the segment
;
N FIELD,DUR,FLD,ORD,FLDIEN,FLDID,FLDDATA
;
; If there isn't any data in this segment then quit
Q:'$D(BPS(9002313.1001))
;
; Second thing - create the 111 field entry as it is not repeating
S FLDDATA=$$SEGID(NODE)
S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
;
; Next- let's look to the format to see which DUR/PPS fields are
; needed (remember - ALL fields on the DUR/PPS segment are optional)
D GETFLDS^BPSOSHF(+IEN(9002313.92),NODE,.FIELD)
;
; Finally -loop through and process the fields for as many times
; as they appear
S DUR=0
F S DUR=$O(BPS(9002313.1001,DUR)) Q:DUR="" D
. S ORD=0
. F S ORD=$O(FIELD(ORD)) Q:ORD="" D
.. S FLDIEN=$P(FIELD(ORD),U)
.. S FLD=$P(FIELD(ORD),U,2)
.. S:FLD=473 FLD=.01 ;473 value stored in the .01 field
.. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID
.. ; Transaction data
.. S FLDDATA=$G(BPS(9002313.1001,DUR,FLD,"I"))
.. I FLDDATA="" Q
.. ;
.. I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the fld empty?
.. ;
.. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
;
Q
;
PROCCOB ;The COB OTHER PAYMENTS segment can repeat itself for any given
; transaction within a claim. This means we have to have special
; programming to handle the repeating fields.
;
; Note that BPS array is set in BPSOSC* routines
;
N FIELD,BPCOB,FLD,ORD
;
; If there isn't any data in this segment quit
Q:'$D(BPS(9002313.0401))
;
; create the 111 field entry as it is not repeating
S FLDDATA=$$SEGID(NODE)
S SEGREC=SEGREC_$C(28)_FLDDATA ; FS always proceeds fld
;
; look to the format to see which COB fields are needed
D GETFLDS^BPSOSHF(+IEN(9002313.92),NODE,.FIELD)
;
; loop through and process fields for as many times as they appear
S BPCOB=0
F S BPCOB=$O(BPS(9002313.0401,BPCOB)) Q:BPCOB="" D
. S ORD=0
. F S ORD=$O(FIELD(ORD)) Q:ORD="" D
.. S FLDIEN=$P(FIELD(ORD),U)
.. S FLD=$P(FIELD(ORD),U,2)
.. S:FLD=337 FLD=.01 ; 473-7E value stored in the .01 field
.. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID
.. ; Transaction data
.. S FLDDATA=$G(BPS(9002313.0401,BPCOB,FLD,"I"))
.. ;
.. Q:FLDDATA=""
.. I $TR(FLDDATA,"0 {}")="HB" Q
.. I $TR(FLDDATA,"0 {}")="5E" Q
..;
..I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the fld empty?
..S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
..; handle repeating fields
..I FLD=471 D REJCODES ; (#471) OTHER PAYER REJECT COUNT
..I FLD=341 D AMTPAID ; (#341) OTHER PAYER AMOUNT PAID COUNT
..I FLD=353 D PATPAID ; (#353) OTHER PAYER-PATIENT RESPONSIBILITY COUNT
..I FLD=392 D BENSTAGE ; (#392) BENEFIT STAGE COUNT
;
Q
;
AMTPAID ; (#342) OTHER PAYER AMT PAID QUALIFIER multiple
N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
S BPCOB=0
F S BPCOB=$O(BPS(9002313.401342,BPCOB)) Q:BPCOB="" D
. S ORD=0
. F S ORD=$O(FIELD(ORD)) Q:ORD="" D
.. S FLDIEN=$P(FIELD(ORD),U)
.. S FLD=$P(FIELD(ORD),U,2)
.. S:FLD=342 FLD=.01 ;342 value stored in the .01 field
.. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID
.. ; Transaction data
.. S FLDDATA=$G(BPS(9002313.401342,BPCOB,FLD,"I"))
.. ;
.. ;quit if null or blank
.. Q:FLDDATA=""
.. I FLDID'="HC",FLDID=$TR(FLDDATA," ") Q ; blanks are ok for 342-HC, but not for 431-DV
.. ;
.. S DATAFND=1
.. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
Q
;
REJCODES ; (#472) OTHER PAYER REJECT CODE
N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
S BPCOB=0
F S BPCOB=$O(BPS(9002313.401472,BPCOB)) Q:BPCOB="" D
. S ORD=0
. F S ORD=$O(FIELD(ORD)) Q:ORD="" D
.. S FLDIEN=$P(FIELD(ORD),U)
.. S FLD=$P(FIELD(ORD),U,2)
.. S:FLD=472 FLD=.01 ;472 value stored in the .01 field
.. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID
.. ; Transaction data
.. S FLDDATA=$G(BPS(9002313.401472,BPCOB,FLD,"I"))
.. ;
.. ;quit if null or blank
.. Q:FLDDATA=""
.. I FLDID=$TR(FLDDATA,"0 {}") Q
.. ;
.. I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the fld empty?
.. ;
.. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
Q
;
PATPAID ; (#353.01) OTHER PAYER-PATIENT RESPONSIBILITY multiple
N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
S BPCOB=0
F S BPCOB=$O(BPS(9002313.401353,BPCOB)) Q:BPCOB="" D
. S ORD=0
. F S ORD=$O(FIELD(ORD)) Q:ORD="" D
.. S FLDIEN=$P(FIELD(ORD),U)
.. S FLD=$P(FIELD(ORD),U,2)
.. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID
.. ; Transaction data
.. S FLDDATA=$G(BPS(9002313.401353,BPCOB,FLD,"I"))
.. ;
.. ;quit if null or blank
.. I FLDDATA=""!(FLDID=$TR(FLDDATA," ")) Q ; Check for missing data or only field ID
.. ;
.. S DATAFND=1
.. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
Q
;
BENSTAGE ; (#392.01) BENEFIT STAGE MLTPL multiple
;
N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
S BPCOB=0
F S BPCOB=$O(BPS(9002313.401392,BPCOB)) Q:BPCOB="" D
. S ORD=0
. F S ORD=$O(FIELD(ORD)) Q:ORD="" D
.. S FLDIEN=$P(FIELD(ORD),U)
.. S FLD=$P(FIELD(ORD),U,2)
.. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID
.. ; Transaction data
.. S FLDDATA=$G(BPS(9002313.401392,BPCOB,FLD,"I"))
.. ;
.. ;quit if null or blank
.. I FLDDATA=""!(FLDID=$TR(FLDDATA," ")) Q ; Check for missing data or only field ID
.. ;
.. S DATAFND=1
.. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld
Q
;
SUBCLAR(DATAFND,BPSIEN,SEGREC) ;
; BPSIEN, SEGREC passed by ref., SEGREC is updated with repeating fields
; 420-DK Submission Clarification Code, a repeating group
;
Q:'$G(BPSIEN(9002313.02)) ; BPS CLAIMS ien
Q:'$G(BPSIEN(9002313.0201)) ; TRANSACTIONS ien (sub-file 9002313.0201)
;
N BPSD0,BPSD1,BPSD2,X1,X4
;
S BPSD0=BPSIEN(9002313.02),BPSD1=BPSIEN(9002313.0201),BPSD2=0
;
S X4=$P($G(^BPSC(BPSD0,400,BPSD1,350)),U,4) ; (#354) SUBM CLARIFICATION CODE COUNT
;
I X4=""!($TR(X4,"0 {}")="NX") Q ; Quit if the count is missing is only the ID
;
F S BPSD2=$O(^BPSC(BPSD0,400,BPSD1,354.01,BPSD2)) Q:'BPSD2 D
.S X1=$P($G(^BPSC(BPSD0,400,BPSD1,354.01,BPSD2,1)),U,1)
.I X1=""!($TR(X1," {}")="DK") Q ; Quit if the code is missing or only the ID
.S SEGREC=SEGREC_$C(28)_X1 ; FS always proceeds fld
.S DATAFND=1 ; data found, result is true
;
Q
;
OAMTCLMD(DATAFND,BPSIEN,SEGREC) ;
; BPSIEN, SEGREC passed by ref., SEGREC updated with pairs of repeating fields
; (#478.01) OTHER AMT CLAIMED MULTIPLE (sub-file 9002313.0601)
;
Q:'$G(BPSIEN(9002313.02)) ; BPS CLAIMS ien
Q:'$G(BPSIEN(9002313.0201)) ; TRANSACTIONS ien (sub-file 9002313.0201)
;
N BPSD0,BPSD1,BPSD2,X,X2,X3
;
S BPSD0=BPSIEN(9002313.02),BPSD1=BPSIEN(9002313.0201),BPSD2=0
;
F S BPSD2=$O(^BPSC(BPSD0,400,BPSD1,478.01,BPSD2)) Q:'BPSD2 D
.S X=$G(^BPSC(BPSD0,400,BPSD1,478.01,BPSD2,0))
.I X="" Q ; Quit if the node is missing
.S X2=$P(X,U,2) ; (#479) OTHER AMT CLAIMED SUBMTTD QLFR
.S X3=$P(X,U,3) ; (#480) OTHER AMOUNT CLAIMED SUBMITTED
.I X2=""!($TR(X2,"0 {}")="H8") Q ; Quit if the qualifier is missing or just the ID
.I X3=""!($TR(X3,"0 {}")="H9") Q ; Quit if the amount is missing or just the ID
.S SEGREC=SEGREC_$C(28)_X2_$C(28)_X3 ; FS always proceeds fld
.S DATAFND=1 ; data found, result is true
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSH2 16613 printed Apr 09, 2024@20:57:18 Page 2
BPSOSH2 ;BHAM ISC/SD/lwj/DLF - Assemble formatted claim ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10,15,19,20,23,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; 5.1 had 14 claim segments (Header, Patient, Insurance, Claim
+5 ; Pharmacy Provider, Prescriber,
+6 ; COB, Workers Comp, DUR, Pricing,
+7 ; Coupon, Compound, Prior Auth,
+8 ; Clinical)
+9 ;
+10 ; D.0 added 3 new request segments (Additional Documentation,
+11 ; Facility, Narrative)
+12 ;
+13 ; D.1 - D.9 introduces Alphanumeric NCPDP numbers and new
+14 ; Purchase and Provider segments
+15 ;
+16 ; E.0 - E.6 added 2 new request segments (Intermediary, Last
+17 ; Known 4RX)
+18 ;
+19 ; 5.1/D.0 requires field identifiers and separators on all fields
+20 ; other than the header
+21 ; 5.1/D.0 segment separators are required prior to each segment
+22 ; following the header
+23 ; 5.1/D.0 group separators appear at the end of each
+24 ; transaction (prescription)
+25 ; 5.1/D.0 only want to send segments that have data - a new
+26 ; segment record will hold the data until we are sure
+27 ; we have something to send
+28 ;
+29 ; Put together ASCII formatted record per the Payer Sheet Definition
+30 ; Input:
+31 ; NODES - "100^110^120" or "130^140^150^160^170^180^190^200^210^220^230^240^250^260^270^280^290^300"
+32 ; Passed by Ref:
+33 ; .IEN - Internal Entry Number array
+34 ; .BPS - Formatted Data Array with claim and transaction data
+35 ; .REC - Formatted ASCII record (result)
+36 ;
XLOOP(NODES,IEN,BPS,REC) ;EP - from BPSECA1
+1 ;
+2 NEW DATAFND,FDATA,FLAG,FLDDATA,FLDID,FLDIEN,FLDNUM,IEN511,IEN59,INDEX,MDATA,NODE,NODEIEN,ORDER,PMODE,RECMIEN,SEGREC
+3 NEW VER,TYPE,BPSX
+4 ;
+5 ; Get payer sheet version and transaction type
+6 SET VER=$PIECE($GET(^BPSF(9002313.92,+$GET(IEN(9002313.92)),1)),U,2)
+7 SET TYPE=$GET(BPS(9002313.02,+$GET(IEN(9002313.02)),103,"I"))
+8 ;
+9 ; Loop through the NODES variable delimited by U
+10 FOR INDEX=1:1:$LENGTH(NODES,U)
Begin DoDot:1
+11 SET NODE=$PIECE(NODES,U,INDEX)
if NODE=""
QUIT
+12 ;
+13 ; VA does not support these segments
+14 if ",300,290,280,270,260,250,240,230,220,210,200,170,140,"[NODE
QUIT
+15 ;
+16 ; Quit if the payer sheet does not have the node
+17 if '$DATA(^BPSF(9002313.92,+IEN(9002313.92),NODE,0))
QUIT
+18 ;
+19 ; Per NCPDP standard, reversals do not support segments listed below
+20 IF TYPE="B2"
IF ",300,290,280,270,260,250,240,230,220,210,200,170,150,140,"[NODE
QUIT
+21 ;Patient segment not supported in a D0 reversal
IF TYPE="B2"
IF VER="D0"
IF NODE=110
QUIT
+22 ;
+23 ; Per NCPDP standard, eligibility does not support segments listed below
+24 IF TYPE="E1"
IF ",290,280,270,260,250,230,220,210,200,190,180,170,160,130,"[NODE
QUIT
+25 ;
+26 ; indicates if data is on the segment for us to send
SET DATAFND=0
+27 ; segment's information
SET SEGREC=""
+28 ;
+29 if NODE=180
DO PROCDUR
+30 ;
+31 ;COB fields
+32 if NODE=160
DO PROCCOB
+33 ;
+34 SET ORDER=""
+35 FOR
Begin DoDot:2
+36 ;
+37 ; DUR/PPS section (repeating), already processed
if NODE=180
QUIT
+38 ; COB data processed earlier
if NODE=160
QUIT
+39 SET ORDER=$ORDER(^BPSF(9002313.92,+IEN(9002313.92),NODE,"B",ORDER))
+40 if 'ORDER
QUIT
+41 SET RECMIEN=""
+42 SET RECMIEN=$ORDER(^BPSF(9002313.92,+IEN(9002313.92),NODE,"B",ORDER,RECMIEN))
+43 if RECMIEN=""
QUIT
+44 ;
+45 SET MDATA=$GET(^BPSF(9002313.92,+IEN(9002313.92),NODE,RECMIEN,0))
+46 if MDATA=""
QUIT
+47 ;
+48 SET FLDIEN=$PIECE(MDATA,U,2)
+49 if FLDIEN=""
QUIT
+50 ;
+51 SET FDATA=$GET(^BPSF(9002313.91,FLDIEN,0))
+52 if FDATA=""
QUIT
+53 SET FLDNUM=$PIECE(FDATA,U,1)
+54 if FLDNUM=""
QUIT
+55 ;Check for alphanumeric NCPDP numbers - BPS*1*15
+56 IF $PIECE(FLDNUM,".")'?3N
SET FLDNUM=$$VNUM^BPSECMPS(FLDNUM)
if 'FLDNUM
QUIT
+57 ;
+58 ; BPS NCPDP FIELD DEFS, (#.06) ID
SET FLDID=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U)
+59 ;
+60 ;header data
+61 if NODE<130
SET FLDDATA=$GET(BPS(9002313.02,IEN(9002313.02),FLDNUM,"I"))
+62 ;
+63 ;transaction data
+64 if NODE>120
SET FLDDATA=$GET(BPS(9002313.0201,IEN(9002313.0201),FLDNUM,"I"))
+65 ;BPS*1*15 - allow for zero in NCPDP ID
IF $TRANSLATE($EXTRACT(FLDDATA,3,999),"0 {}")'=""
SET DATAFND=1
+66 ;
+67 ;check if this is the seg id - call this after fld chk since
+68 ;we don't want to send the segment if this is all there is
+69 IF (NODE>100)&(FLDNUM=111)
SET FLDDATA=$$SEGID(NODE)
+70 ;
+71 ; Special code to handle the Submission Clarification Code (420) repeating group
+72 IF FLDNUM=420
DO SUBCLAR(.DATAFND,.IEN,.SEGREC)
QUIT
+73 ;
+74 ; Special code to handle the Other Amount Claimed repeating group
+75 IF FLDNUM=480
DO OAMTCLMD(.DATAFND,.IEN,.SEGREC)
QUIT
+76 ; fields 479 & 480 handled as a pair in OAMTCLMD
IF FLDNUM=479
QUIT
+77 ;
+78 ;lje;7/23/03; don't want extra field separators when field is blank for testing for WebMD.
if FLDDATA=""
QUIT
+79 ;
+80 ;no FS on the header rec
if NODE=100
SET SEGREC=SEGREC_FLDDATA
+81 ;FS always proceeds fld
if NODE>100
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
End DoDot:2
if 'ORDER
QUIT
+82 ;
+83 ; If the current segment is 130/Claim (B1 - Billing Requests only),
+84 ; add field 460-ET QUANTITY PRESCRIBED if data exists and it's not
+85 ; already populated.
+86 ;
+87 IF NODE=130
IF TYPE="B1"
Begin DoDot:2
+88 ; Check to see if 460-ET already added to segment.
+89 IF SEGREC[($CHAR(28)_"ET")
QUIT
+90 SET FLDDATA=BPS(9002313.0201,IEN(9002313.0201),460,"I")
+91 IF FLDDATA'=""
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
+92 QUIT
End DoDot:2
+93 ;
+94 ; If no data on this segment, Quit, don't check for addl. fields.
+95 ;
+96 IF 'DATAFND
QUIT
+97 ;
+98 ; The user has the ability, via the action RED / Resubmit with
+99 ; Edits, to add claim fields not on the payer sheet. Any
+100 ; fields to be added to the claim are stored in the file BPS NCPDP
+101 ; OVERRIDE. Pull the BPS TRANSACTION from the BPS CLAIMS file,
+102 ; then pull the field NCPDP OVERRIDES. If populated, pull any
+103 ; additional fields.
+104 ;
+105 SET IEN59=$$GET1^DIQ(9002313.02,IEN(9002313.02),.08,"I")
+106 SET IEN511=$$GET1^DIQ(9002313.59,IEN59,1.13,"I")
+107 IF IEN511
Begin DoDot:2
+108 ;
+109 ; Loop through additional fields for the current segment
+110 ; (NODE) and add to the claim.
+111 ;
+112 SET NODEIEN=$ORDER(^BPSF(9002313.9,"C",NODE,""))
+113 IF 'NODEIEN
QUIT
+114 SET BPSX=""
+115 FOR
SET BPSX=$ORDER(^BPS(9002313.511,IEN511,2,"SEG",NODEIEN,BPSX))
if BPSX=""
QUIT
Begin DoDot:3
+116 SET FLDIEN=$$GET1^DIQ(9002313.5112,BPSX_","_IEN511_",",.01,"I")
+117 ;
+118 ; The data in the BPS array is stored according to the number
+119 ; of each field in BPS CLAIMS. That number corresponds to the
+120 ; NCPDP field number when the NCPDP number is all numeric. For
+121 ; alphanumeric field numbers, such as "B95", we must call
+122 ; $$VNUM^BPSECMPS to pull the BPS CLAIMS field number from BPS
+123 ; NCPDP FIELD DEFS.
+124 ;
+125 SET FLDNUM=$$GET1^DIQ(9002313.91,FLDIEN,.01,"E")
+126 IF FLDNUM=""
QUIT
+127 IF $PIECE(FLDNUM,".")'?3N
SET FLDNUM=$$VNUM^BPSECMPS(FLDNUM)
IF 'FLDNUM
QUIT
+128 ;
+129 IF NODE<130
SET FLDDATA=$GET(BPS(9002313.02,IEN(9002313.02),FLDNUM,"I"))
+130 IF NODE>120
SET FLDDATA=$GET(BPS(9002313.0201,IEN(9002313.0201),FLDNUM,"I"))
+131 ;
+132 IF FLDDATA=""
QUIT
+133 ;
+134 ; $C(28) = File Separator. On all segments except the Header,
+135 ; FS precedes each field.
+136 ;
+137 IF NODE=100
SET SEGREC=SEGREC_FLDDATA
+138 IF NODE>100
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
+139 ;
+140 QUIT
End DoDot:3
+141 QUIT
End DoDot:2
+142 ;
+143 ;no SS when it's the header
IF NODE=100
SET REC(NODE)=SEGREC
+144 IF NODE>100
Begin DoDot:2
+145 IF '$DATA(REC(NODE))
SET REC(NODE)=REC
IF REC[$CHAR(29)
SET REC=""
+146 ;SS before the seg
SET REC(NODE)=REC(NODE)_$CHAR(30)_SEGREC
End DoDot:2
End DoDot:1
+147 ;
+148 QUIT
+149 ;
SEGID(ND) ; function, returns Segment ID
+1 ; Field 111 is the Segment Identifier - for each segment, other than
+2 ; the header, a unique value must be sent in this field
+3 ; to identify which segment is being sent. This value is not stored
+4 ; in the claim - as it changes with each of the 20 segments. The
+5 ; field does appear as part of the NCPDP Format, but is simply not stored.
+6 ; 01 = Patient 02 = Pharmacy Provider 03 = Prescriber
+7 ; 04 = Insurance 05 = COB/Other Payment 06 = Workers' Comp
+8 ; 07 = Claim 08 = DUR/PPS 09 = Coupon
+9 ; 10 = Compound 11 = Pricing 12 = Prior Auth
+10 ; 13 = Clinical 14 = Additional Doc 15 = Facility
+11 ; 16 = Narrative 17 = Purchaser 18 = Service Provider
+12 ; 19 = Intermediary 37 = Last Known 4Rx
+13 ;
+14 NEW FLD
+15 ;
+16 SET FLD=$SELECT(ND=110:"01",ND=120:"04",ND=130:"07",ND=140:"02",ND=150:"03",ND=160:"05",ND=170:"06",ND=180:"08",ND=190:11,ND=200:"09",ND=210:10,ND=220:12,ND=230:13,ND=240:14,ND=250:15,ND=260:16,ND=270:17,ND=280:18,ND=290:19,ND=300:37,1:"00")
+17 SET FLD="AM"_$$NFF^BPSECFM(FLD,2)
+18 ;
+19 QUIT FLD
+20 ;
PROCDUR ; The DUR/PPS segment can repeat itself for any given
+1 ; transaction within a claim. This means we have to have special
+2 ; programming to handle the repeating fields.
+3 ;
+4 ; Input Data
+5 ; BPS array - Set in BPSOSC* routines
+6 ; IEN array - Contain IEN information for the BPS NCPDP FORMAT file
+7 ; NODE - Multiple of the BPS NCPDP FORMAT file
+8 ; Input/Output Data
+9 ; SEGREC - This is data for the segment being created
+10 ; DATAFND - Flag indicating if there is legitimate data for the segment
+11 ;
+12 NEW FIELD,DUR,FLD,ORD,FLDIEN,FLDID,FLDDATA
+13 ;
+14 ; If there isn't any data in this segment then quit
+15 if '$DATA(BPS(9002313.1001))
QUIT
+16 ;
+17 ; Second thing - create the 111 field entry as it is not repeating
+18 SET FLDDATA=$$SEGID(NODE)
+19 ;FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
+20 ;
+21 ; Next- let's look to the format to see which DUR/PPS fields are
+22 ; needed (remember - ALL fields on the DUR/PPS segment are optional)
+23 DO GETFLDS^BPSOSHF(+IEN(9002313.92),NODE,.FIELD)
+24 ;
+25 ; Finally -loop through and process the fields for as many times
+26 ; as they appear
+27 SET DUR=0
+28 FOR
SET DUR=$ORDER(BPS(9002313.1001,DUR))
if DUR=""
QUIT
Begin DoDot:1
+29 SET ORD=0
+30 FOR
SET ORD=$ORDER(FIELD(ORD))
if ORD=""
QUIT
Begin DoDot:2
+31 SET FLDIEN=$PIECE(FIELD(ORD),U)
+32 SET FLD=$PIECE(FIELD(ORD),U,2)
+33 ;473 value stored in the .01 field
if FLD=473
SET FLD=.01
+34 ; BPS NCPDP FIELD DEFS, (#.06) ID
SET FLDID=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U)
+35 ; Transaction data
+36 SET FLDDATA=$GET(BPS(9002313.1001,DUR,FLD,"I"))
+37 IF FLDDATA=""
QUIT
+38 ;
+39 ;fld chk-is the fld empty?
IF FLDID'=$TRANSLATE(FLDDATA,"0 {}")
SET DATAFND=1
+40 ;
+41 ;FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
End DoDot:2
End DoDot:1
+42 ;
+43 QUIT
+44 ;
PROCCOB ;The COB OTHER PAYMENTS segment can repeat itself for any given
+1 ; transaction within a claim. This means we have to have special
+2 ; programming to handle the repeating fields.
+3 ;
+4 ; Note that BPS array is set in BPSOSC* routines
+5 ;
+6 NEW FIELD,BPCOB,FLD,ORD
+7 ;
+8 ; If there isn't any data in this segment quit
+9 if '$DATA(BPS(9002313.0401))
QUIT
+10 ;
+11 ; create the 111 field entry as it is not repeating
+12 SET FLDDATA=$$SEGID(NODE)
+13 ; FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
+14 ;
+15 ; look to the format to see which COB fields are needed
+16 DO GETFLDS^BPSOSHF(+IEN(9002313.92),NODE,.FIELD)
+17 ;
+18 ; loop through and process fields for as many times as they appear
+19 SET BPCOB=0
+20 FOR
SET BPCOB=$ORDER(BPS(9002313.0401,BPCOB))
if BPCOB=""
QUIT
Begin DoDot:1
+21 SET ORD=0
+22 FOR
SET ORD=$ORDER(FIELD(ORD))
if ORD=""
QUIT
Begin DoDot:2
+23 SET FLDIEN=$PIECE(FIELD(ORD),U)
+24 SET FLD=$PIECE(FIELD(ORD),U,2)
+25 ; 473-7E value stored in the .01 field
if FLD=337
SET FLD=.01
+26 ; BPS NCPDP FIELD DEFS, (#.06) ID
SET FLDID=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U)
+27 ; Transaction data
+28 SET FLDDATA=$GET(BPS(9002313.0401,BPCOB,FLD,"I"))
+29 ;
+30 if FLDDATA=""
QUIT
+31 IF $TRANSLATE(FLDDATA,"0 {}")="HB"
QUIT
+32 IF $TRANSLATE(FLDDATA,"0 {}")="5E"
QUIT
+33 ;
+34 ;fld chk-is the fld empty?
IF FLDID'=$TRANSLATE(FLDDATA,"0 {}")
SET DATAFND=1
+35 ;FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
+36 ; handle repeating fields
+37 ; (#471) OTHER PAYER REJECT COUNT
IF FLD=471
DO REJCODES
+38 ; (#341) OTHER PAYER AMOUNT PAID COUNT
IF FLD=341
DO AMTPAID
+39 ; (#353) OTHER PAYER-PATIENT RESPONSIBILITY COUNT
IF FLD=353
DO PATPAID
+40 ; (#392) BENEFIT STAGE COUNT
IF FLD=392
DO BENSTAGE
End DoDot:2
End DoDot:1
+41 ;
+42 QUIT
+43 ;
AMTPAID ; (#342) OTHER PAYER AMT PAID QUALIFIER multiple
+1 NEW BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
+2 SET BPCOB=0
+3 FOR
SET BPCOB=$ORDER(BPS(9002313.401342,BPCOB))
if BPCOB=""
QUIT
Begin DoDot:1
+4 SET ORD=0
+5 FOR
SET ORD=$ORDER(FIELD(ORD))
if ORD=""
QUIT
Begin DoDot:2
+6 SET FLDIEN=$PIECE(FIELD(ORD),U)
+7 SET FLD=$PIECE(FIELD(ORD),U,2)
+8 ;342 value stored in the .01 field
if FLD=342
SET FLD=.01
+9 ; BPS NCPDP FIELD DEFS, (#.06) ID
SET FLDID=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U)
+10 ; Transaction data
+11 SET FLDDATA=$GET(BPS(9002313.401342,BPCOB,FLD,"I"))
+12 ;
+13 ;quit if null or blank
+14 if FLDDATA=""
QUIT
+15 ; blanks are ok for 342-HC, but not for 431-DV
IF FLDID'="HC"
IF FLDID=$TRANSLATE(FLDDATA," ")
QUIT
+16 ;
+17 SET DATAFND=1
+18 ;FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
REJCODES ; (#472) OTHER PAYER REJECT CODE
+1 NEW BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
+2 SET BPCOB=0
+3 FOR
SET BPCOB=$ORDER(BPS(9002313.401472,BPCOB))
if BPCOB=""
QUIT
Begin DoDot:1
+4 SET ORD=0
+5 FOR
SET ORD=$ORDER(FIELD(ORD))
if ORD=""
QUIT
Begin DoDot:2
+6 SET FLDIEN=$PIECE(FIELD(ORD),U)
+7 SET FLD=$PIECE(FIELD(ORD),U,2)
+8 ;472 value stored in the .01 field
if FLD=472
SET FLD=.01
+9 ; BPS NCPDP FIELD DEFS, (#.06) ID
SET FLDID=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U)
+10 ; Transaction data
+11 SET FLDDATA=$GET(BPS(9002313.401472,BPCOB,FLD,"I"))
+12 ;
+13 ;quit if null or blank
+14 if FLDDATA=""
QUIT
+15 IF FLDID=$TRANSLATE(FLDDATA,"0 {}")
QUIT
+16 ;
+17 ;fld chk-is the fld empty?
IF FLDID'=$TRANSLATE(FLDDATA,"0 {}")
SET DATAFND=1
+18 ;
+19 ;FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
PATPAID ; (#353.01) OTHER PAYER-PATIENT RESPONSIBILITY multiple
+1 NEW BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
+2 SET BPCOB=0
+3 FOR
SET BPCOB=$ORDER(BPS(9002313.401353,BPCOB))
if BPCOB=""
QUIT
Begin DoDot:1
+4 SET ORD=0
+5 FOR
SET ORD=$ORDER(FIELD(ORD))
if ORD=""
QUIT
Begin DoDot:2
+6 SET FLDIEN=$PIECE(FIELD(ORD),U)
+7 SET FLD=$PIECE(FIELD(ORD),U,2)
+8 ; BPS NCPDP FIELD DEFS, (#.06) ID
SET FLDID=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U)
+9 ; Transaction data
+10 SET FLDDATA=$GET(BPS(9002313.401353,BPCOB,FLD,"I"))
+11 ;
+12 ;quit if null or blank
+13 ; Check for missing data or only field ID
IF FLDDATA=""!(FLDID=$TRANSLATE(FLDDATA," "))
QUIT
+14 ;
+15 SET DATAFND=1
+16 ;FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
BENSTAGE ; (#392.01) BENEFIT STAGE MLTPL multiple
+1 ;
+2 NEW BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA
+3 SET BPCOB=0
+4 FOR
SET BPCOB=$ORDER(BPS(9002313.401392,BPCOB))
if BPCOB=""
QUIT
Begin DoDot:1
+5 SET ORD=0
+6 FOR
SET ORD=$ORDER(FIELD(ORD))
if ORD=""
QUIT
Begin DoDot:2
+7 SET FLDIEN=$PIECE(FIELD(ORD),U)
+8 SET FLD=$PIECE(FIELD(ORD),U,2)
+9 ; BPS NCPDP FIELD DEFS, (#.06) ID
SET FLDID=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U)
+10 ; Transaction data
+11 SET FLDDATA=$GET(BPS(9002313.401392,BPCOB,FLD,"I"))
+12 ;
+13 ;quit if null or blank
+14 ; Check for missing data or only field ID
IF FLDDATA=""!(FLDID=$TRANSLATE(FLDDATA," "))
QUIT
+15 ;
+16 SET DATAFND=1
+17 ;FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
SUBCLAR(DATAFND,BPSIEN,SEGREC) ;
+1 ; BPSIEN, SEGREC passed by ref., SEGREC is updated with repeating fields
+2 ; 420-DK Submission Clarification Code, a repeating group
+3 ;
+4 ; BPS CLAIMS ien
if '$GET(BPSIEN(9002313.02))
QUIT
+5 ; TRANSACTIONS ien (sub-file 9002313.0201)
if '$GET(BPSIEN(9002313.0201))
QUIT
+6 ;
+7 NEW BPSD0,BPSD1,BPSD2,X1,X4
+8 ;
+9 SET BPSD0=BPSIEN(9002313.02)
SET BPSD1=BPSIEN(9002313.0201)
SET BPSD2=0
+10 ;
+11 ; (#354) SUBM CLARIFICATION CODE COUNT
SET X4=$PIECE($GET(^BPSC(BPSD0,400,BPSD1,350)),U,4)
+12 ;
+13 ; Quit if the count is missing is only the ID
IF X4=""!($TRANSLATE(X4,"0 {}")="NX")
QUIT
+14 ;
+15 FOR
SET BPSD2=$ORDER(^BPSC(BPSD0,400,BPSD1,354.01,BPSD2))
if 'BPSD2
QUIT
Begin DoDot:1
+16 SET X1=$PIECE($GET(^BPSC(BPSD0,400,BPSD1,354.01,BPSD2,1)),U,1)
+17 ; Quit if the code is missing or only the ID
IF X1=""!($TRANSLATE(X1," {}")="DK")
QUIT
+18 ; FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_X1
+19 ; data found, result is true
SET DATAFND=1
End DoDot:1
+20 ;
+21 QUIT
+22 ;
OAMTCLMD(DATAFND,BPSIEN,SEGREC) ;
+1 ; BPSIEN, SEGREC passed by ref., SEGREC updated with pairs of repeating fields
+2 ; (#478.01) OTHER AMT CLAIMED MULTIPLE (sub-file 9002313.0601)
+3 ;
+4 ; BPS CLAIMS ien
if '$GET(BPSIEN(9002313.02))
QUIT
+5 ; TRANSACTIONS ien (sub-file 9002313.0201)
if '$GET(BPSIEN(9002313.0201))
QUIT
+6 ;
+7 NEW BPSD0,BPSD1,BPSD2,X,X2,X3
+8 ;
+9 SET BPSD0=BPSIEN(9002313.02)
SET BPSD1=BPSIEN(9002313.0201)
SET BPSD2=0
+10 ;
+11 FOR
SET BPSD2=$ORDER(^BPSC(BPSD0,400,BPSD1,478.01,BPSD2))
if 'BPSD2
QUIT
Begin DoDot:1
+12 SET X=$GET(^BPSC(BPSD0,400,BPSD1,478.01,BPSD2,0))
+13 ; Quit if the node is missing
IF X=""
QUIT
+14 ; (#479) OTHER AMT CLAIMED SUBMTTD QLFR
SET X2=$PIECE(X,U,2)
+15 ; (#480) OTHER AMOUNT CLAIMED SUBMITTED
SET X3=$PIECE(X,U,3)
+16 ; Quit if the qualifier is missing or just the ID
IF X2=""!($TRANSLATE(X2,"0 {}")="H8")
QUIT
+17 ; Quit if the amount is missing or just the ID
IF X3=""!($TRANSLATE(X3,"0 {}")="H9")
QUIT
+18 ; FS always proceeds fld
SET SEGREC=SEGREC_$CHAR(28)_X2_$CHAR(28)_X3
+19 ; data found, result is true
SET DATAFND=1
End DoDot:1
+20 ;
+21 QUIT
+22 ;
