BPSOSCF ;BHAM ISC/FCS/DRS/DLF - Low-level format of .02 ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10,15,19,23,28,40,41**;JUN 2004;Build 11
;;Per VA Directive 6402, this routine should not be modified.
;
; 100 (Transaction Header Segment)
; 110 (Patient Segment)
; 120 (Insurance Segment)
; 130 (Claim Segment)
; 140 (Pharmacy Provider Segment)
; 150 (Prescriber Segment)
; 160 (COB/Other Payments Segment)
; 170 (Worker's Compensation Segment)
; 180 (DUR/PPS Segment)
; 190 (Pricing Segment)
; 200 (Coupon Segment)
; 210 (Compound Segment)
; 220 (Prior Authorization Segment)
; 230 (Clinical Segment)
; 240 (Additional Documentation Segment)
; 250 (Facility Segment)
; 260 (Narrative Segment)
; 270 (Purchaser Segment)
; 280 (Service Provider Segment)
; 290 (Intermediary Segment)
; 300 (Last Known 4Rx Segment)
;
; FORMAT = IEN to file #9002313.92, BPS NCPDP FORMATS
; NODE = A specific segment node (e.g. 100, 110)
; MEDN = Transaction multiple in BPS Claims
XLOOP(FORMAT,NODE,MEDN) ; format claim record
;
; Both FORMAT and NODE are required.
I $G(FORMAT)="" Q
I $G(NODE)="" Q
;
N FLAG,FLDIEN,FLDINFO,IEN511,IEN59,MDATA,NCPVERS,NODEIEN,ORDER
N OVERRIDE,PMODE,RECMIEN,BPSX
;
; quit If the payer sheet doesn't have the segment
I NODE'=230,'$D(^BPSF(9002313.92,FORMAT,NODE,0)) Q
;
; VA doesn't do these segments
I ",300,290,280,270,260,250,240,220,210,200,170,140,"[(","_NODE_",") Q
;
; Per NCPDP standard, eligibility doesn't support segments listed below
I BPS("Transaction Code")="E1",",290,280,270,260,250,230,220,210,200,190,180,170,160,130,"[(","_NODE_",") Q
;
; For COB, if the payer sequence is primary, then quit and don't output the COB fields
I NODE=160,$$COB59^BPSUTIL2(+$G(BPS("RX",BPS(9002313.0201),"IEN59")))=1 Q
;
; COB processing is handled differently
I NODE=160 D COB^BPSOSHF(FORMAT,NODE,MEDN) Q
;
; DUR is handled differently since it is repeating
I NODE=180 D DURPPS^BPSOSHF(FORMAT,NODE,MEDN) Q
;
; The Diagnosis related fields will be populated only if the user
; entered a diagnosis code via the RED Action (ECME User Screen) or
; the DIA Action (Pharmacist Worklist).
I NODE=230 D DXFIELDS^BPSOSH3 Q
;
; Loop through the fields in the segment
S ORDER=0
F S ORDER=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER)) Q:'ORDER D
. ;
. ; Set MDATA to the record from file 9002313.92, BPS NCPDP FORMATS.
. S RECMIEN=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER,0))
. I 'RECMIEN D IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$T(+0)) Q
. S MDATA=^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)
. ;
. ; Get the pointer to the BPS NCPDP FIELD DEFS table
. S FLDIEN=$P(MDATA,U,2)
. I 'FLDIEN Q
. ;
. S FLDINFO=$G(^BPSF(9002313.91,FLDIEN,0)) ; BPS NCPDP FIELD DEFS (#9002313.91)
. I FLDINFO="" D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XLOOP",$T(+0)) Q
. ;
. ; Quit for 111-AM Segment Identification (standard field for each segment)
. ; 478-H7 Other Amount Claimed Submitted Count (handled with
. ; 479-H8 Other Amount Claimed Submitted Qualifier field 480)
. S BPSX=$P(FLDINFO,U)
. I ",111,478,479,"[(","_BPSX_",") Q
. ;
. ; Set override value (may not be defined so override will be null)
. I $D(MEDN) S OVERRIDE=$G(BPS("OVERRIDE","RX",MEDN,FLDIEN))
. E S OVERRIDE=$G(BPS("OVERRIDE",FLDIEN))
. ;
. ; Get processing mode (S-Standard (default), X-Special Code)
. S PMODE=$P(MDATA,U,3)
. I PMODE="" S PMODE="S"
. ;
. ; Default FLAG and value being computed
. S FLAG="GFS"
. S BPS("X")=""
. ;
. ; If there is an override, set BPS("X") to it and
. ; only do Format and Set code
. I OVERRIDE]"" S FLAG="FS",BPS("X")=OVERRIDE
. ;
. ; If Special Code mode is set, execute special code instead
. ; of field's Get code and change Flag to FS so Format and
. ; Set code is still done but not GET code
. I PMODE="X",OVERRIDE="" D
. . S FLAG="FS"
. . D XSPCCODE(FORMAT,NODE,RECMIEN)
. ;
. ; Call XFLDCODE to do processing based on FLAG setting
. D XFLDCODE(NODE,FLDIEN,FLAG)
;
; If the current segment is 110/Patient, conditionally populate
; field 335-2C PREGNANCY INDICATOR.
;
I NODE=110 D PREG^BPSOSH3
;
; If the current segment is 130/Claim, populate field 460-ET
; QUANTITY PRESCRIBED if it's not already populated.
;
I NODE=130 D
. I $$GET1^DIQ(9002313.0201,BPS(9002313.0201)_","_BPS(9002313.02),460,"I")'="" Q
. S FLDIEN=$O(^BPSF(9002313.91,"B",460,""))
. I FLDIEN="" Q
. D XFLDCODE(NODE,FLDIEN,"GFS")
. Q
;
; The user has the ability to add to the claim fields not on the payer
; sheet. This is done via the action RED/Resubmit with Edits on the
; ECME User Screen or via the action ECS/Edit Claim Submitted on the
; Reject Information Screen. Any fields to be added to the claim are
; stored in the file BPS NCPDP OVERRIDE.
;
; Determine the transaction from the claim. Determine
; override, and Quit if none. Field 1.13 is NCPDP OVERRIDES,
; ptr to 9002313.511.
;
S IEN59=$$CLAIM59^BPSUTIL2(BPS(9002313.02))
S IEN511=$$GET1^DIQ(9002313.59,IEN59,1.13,"I")
I 'IEN511 Q
;
; Loop through additional fields for the current segment (NODE) and
; call XFLDCODE to 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")
. S BPS("X")=""
. D XFLDCODE(NODE,FLDIEN,"GFS")
;
Q
;
; Execute Get, Format, and/or Set MUMPS code for NCPDP Field
;
; Parameters: NODE - Segment Node
; FLDIEN - NCPDP Field Definitions IEN
; FLAG - If variable contains:
; "G" - Execute Get Code
; "F" - Execute Format Code
; "S" - Execute S Code
;
; When called by the DURPPS^BPSOSHF, DUR is also set and used
; by the SET logic for the DUR fields. This variable is newed
; by the calling routine
XFLDCODE(NODE,FLDIEN,FLAG) ;EP
;
N FNODE,INDEX,MCODE,NCPVERS,X
;
; Check if record exists and FLAG variable is set correctly
I 'FLDIEN D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XFLDCODE",$T(+0)) Q
I FLAG="" D IMPOSS^BPSOSUE("DB,P","TI","FLAG null",,"XFLDCODE",$T(+0)) Q
;
; get NCPDP version, default to vD.0
S NCPVERS=$G(BPS("NCPDP","Version"))
I NCPVERS="" S NCPVERS="D0"
;
; Loop through GET CODE, D0 FORMAT (or FORMAT), SET CODE w-p fields and execute code
F FNODE=10,20,25,30 D
. I FNODE=25,NCPVERS="D0" Q ; node 25 is FORMAT CODE for versions before D.0
. I FNODE=20,NCPVERS'="D0" Q ; node 20 is FORMAT CODE for vD.0
. I FLAG'[$S(FNODE=10:"G",FNODE=25!(FNODE=20):"F",FNODE=30:"S",1:"") Q
. I '$D(^BPSF(9002313.91,FLDIEN,FNODE,0)) D IMPOSS^BPSOSUE("DB","TI","FLDIEN="_FLDIEN,"FNODE="_FNODE,"XFLDCODE",$T(+0))
. ;
. ; If doing SET code and if this is not the header segment, add the ID prefix
. I FNODE=30,NODE'=100 S BPS("X")=$P($G(^BPSF(9002313.91,FLDIEN,5)),U,1)_BPS("X")
. ;
. ; Loop through the W-P field and execute each line
. S INDEX=0
. F S INDEX=$O(^BPSF(9002313.91,FLDIEN,FNODE,INDEX)) Q:'INDEX D
. . ; Get the code and xecute
. . S MCODE=$G(^BPSF(9002313.91,FLDIEN,FNODE,INDEX,0))
. . I MCODE="" Q
. . I $E(MCODE,1)=";" Q
. . X MCODE
;
Q
;
; Execute Special Code (for NCPDP Field within NCPDP Record)
; FORMAT = NCPDP Record Format IEN (9002313.92)
; NODE = Global node value (100,110,120,130,140)
; RECMIEN = Field Multiple IEN
XSPCCODE(FORMAT,NODE,RECMIEN) ;EP - Above and BPSOSHR
; BPS NCPDP FORMATS (#9002313.92)
I '$D(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)) D IMPOSS^BPSOSUE("DB,P","TI","no special code there to XECUTE","FORMAT="_FORMAT,"XSPCCODE",$T(+0)) Q
N INDEX,MCODE
S INDEX=0
F S INDEX=$O(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX)) Q:'INDEX D
. ; Get the code and xecute
. S MCODE=$G(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX,0))
. I MCODE="" Q
. I $E(MCODE,1)=";" Q
. X MCODE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSCF 8176 printed Jan 29, 2026@14:50:22 Page 2
BPSOSCF ;BHAM ISC/FCS/DRS/DLF - Low-level format of .02 ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10,15,19,23,28,40,41**;JUN 2004;Build 11
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; 100 (Transaction Header Segment)
+5 ; 110 (Patient Segment)
+6 ; 120 (Insurance Segment)
+7 ; 130 (Claim Segment)
+8 ; 140 (Pharmacy Provider Segment)
+9 ; 150 (Prescriber Segment)
+10 ; 160 (COB/Other Payments Segment)
+11 ; 170 (Worker's Compensation Segment)
+12 ; 180 (DUR/PPS Segment)
+13 ; 190 (Pricing Segment)
+14 ; 200 (Coupon Segment)
+15 ; 210 (Compound Segment)
+16 ; 220 (Prior Authorization Segment)
+17 ; 230 (Clinical Segment)
+18 ; 240 (Additional Documentation Segment)
+19 ; 250 (Facility Segment)
+20 ; 260 (Narrative Segment)
+21 ; 270 (Purchaser Segment)
+22 ; 280 (Service Provider Segment)
+23 ; 290 (Intermediary Segment)
+24 ; 300 (Last Known 4Rx Segment)
+25 ;
+26 ; FORMAT = IEN to file #9002313.92, BPS NCPDP FORMATS
+27 ; NODE = A specific segment node (e.g. 100, 110)
+28 ; MEDN = Transaction multiple in BPS Claims
XLOOP(FORMAT,NODE,MEDN) ; format claim record
+1 ;
+2 ; Both FORMAT and NODE are required.
+3 IF $GET(FORMAT)=""
QUIT
+4 IF $GET(NODE)=""
QUIT
+5 ;
+6 NEW FLAG,FLDIEN,FLDINFO,IEN511,IEN59,MDATA,NCPVERS,NODEIEN,ORDER
+7 NEW OVERRIDE,PMODE,RECMIEN,BPSX
+8 ;
+9 ; quit If the payer sheet doesn't have the segment
+10 IF NODE'=230
IF '$DATA(^BPSF(9002313.92,FORMAT,NODE,0))
QUIT
+11 ;
+12 ; VA doesn't do these segments
+13 IF ",300,290,280,270,260,250,240,220,210,200,170,140,"[(","_NODE_",")
QUIT
+14 ;
+15 ; Per NCPDP standard, eligibility doesn't support segments listed below
+16 IF BPS("Transaction Code")="E1"
IF ",290,280,270,260,250,230,220,210,200,190,180,170,160,130,"[(","_NODE_",")
QUIT
+17 ;
+18 ; For COB, if the payer sequence is primary, then quit and don't output the COB fields
+19 IF NODE=160
IF $$COB59^BPSUTIL2(+$GET(BPS("RX",BPS(9002313.0201),"IEN59")))=1
QUIT
+20 ;
+21 ; COB processing is handled differently
+22 IF NODE=160
DO COB^BPSOSHF(FORMAT,NODE,MEDN)
QUIT
+23 ;
+24 ; DUR is handled differently since it is repeating
+25 IF NODE=180
DO DURPPS^BPSOSHF(FORMAT,NODE,MEDN)
QUIT
+26 ;
+27 ; The Diagnosis related fields will be populated only if the user
+28 ; entered a diagnosis code via the RED Action (ECME User Screen) or
+29 ; the DIA Action (Pharmacist Worklist).
+30 IF NODE=230
DO DXFIELDS^BPSOSH3
QUIT
+31 ;
+32 ; Loop through the fields in the segment
+33 SET ORDER=0
+34 FOR
SET ORDER=$ORDER(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER))
if 'ORDER
QUIT
Begin DoDot:1
+35 ;
+36 ; Set MDATA to the record from file 9002313.92, BPS NCPDP FORMATS.
+37 SET RECMIEN=$ORDER(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER,0))
+38 IF 'RECMIEN
DO IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$TEXT(+0))
QUIT
+39 SET MDATA=^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)
+40 ;
+41 ; Get the pointer to the BPS NCPDP FIELD DEFS table
+42 SET FLDIEN=$PIECE(MDATA,U,2)
+43 IF 'FLDIEN
QUIT
+44 ;
+45 ; BPS NCPDP FIELD DEFS (#9002313.91)
SET FLDINFO=$GET(^BPSF(9002313.91,FLDIEN,0))
+46 IF FLDINFO=""
DO IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XLOOP",$TEXT(+0))
QUIT
+47 ;
+48 ; Quit for 111-AM Segment Identification (standard field for each segment)
+49 ; 478-H7 Other Amount Claimed Submitted Count (handled with
+50 ; 479-H8 Other Amount Claimed Submitted Qualifier field 480)
+51 SET BPSX=$PIECE(FLDINFO,U)
+52 IF ",111,478,479,"[(","_BPSX_",")
QUIT
+53 ;
+54 ; Set override value (may not be defined so override will be null)
+55 IF $DATA(MEDN)
SET OVERRIDE=$GET(BPS("OVERRIDE","RX",MEDN,FLDIEN))
+56 IF '$TEST
SET OVERRIDE=$GET(BPS("OVERRIDE",FLDIEN))
+57 ;
+58 ; Get processing mode (S-Standard (default), X-Special Code)
+59 SET PMODE=$PIECE(MDATA,U,3)
+60 IF PMODE=""
SET PMODE="S"
+61 ;
+62 ; Default FLAG and value being computed
+63 SET FLAG="GFS"
+64 SET BPS("X")=""
+65 ;
+66 ; If there is an override, set BPS("X") to it and
+67 ; only do Format and Set code
+68 IF OVERRIDE]""
SET FLAG="FS"
SET BPS("X")=OVERRIDE
+69 ;
+70 ; If Special Code mode is set, execute special code instead
+71 ; of field's Get code and change Flag to FS so Format and
+72 ; Set code is still done but not GET code
+73 IF PMODE="X"
IF OVERRIDE=""
Begin DoDot:2
+74 SET FLAG="FS"
+75 DO XSPCCODE(FORMAT,NODE,RECMIEN)
End DoDot:2
+76 ;
+77 ; Call XFLDCODE to do processing based on FLAG setting
+78 DO XFLDCODE(NODE,FLDIEN,FLAG)
End DoDot:1
+79 ;
+80 ; If the current segment is 110/Patient, conditionally populate
+81 ; field 335-2C PREGNANCY INDICATOR.
+82 ;
+83 IF NODE=110
DO PREG^BPSOSH3
+84 ;
+85 ; If the current segment is 130/Claim, populate field 460-ET
+86 ; QUANTITY PRESCRIBED if it's not already populated.
+87 ;
+88 IF NODE=130
Begin DoDot:1
+89 IF $$GET1^DIQ(9002313.0201,BPS(9002313.0201)_","_BPS(9002313.02),460,"I")'=""
QUIT
+90 SET FLDIEN=$ORDER(^BPSF(9002313.91,"B",460,""))
+91 IF FLDIEN=""
QUIT
+92 DO XFLDCODE(NODE,FLDIEN,"GFS")
+93 QUIT
End DoDot:1
+94 ;
+95 ; The user has the ability to add to the claim fields not on the payer
+96 ; sheet. This is done via the action RED/Resubmit with Edits on the
+97 ; ECME User Screen or via the action ECS/Edit Claim Submitted on the
+98 ; Reject Information Screen. Any fields to be added to the claim are
+99 ; stored in the file BPS NCPDP OVERRIDE.
+100 ;
+101 ; Determine the transaction from the claim. Determine
+102 ; override, and Quit if none. Field 1.13 is NCPDP OVERRIDES,
+103 ; ptr to 9002313.511.
+104 ;
+105 SET IEN59=$$CLAIM59^BPSUTIL2(BPS(9002313.02))
+106 SET IEN511=$$GET1^DIQ(9002313.59,IEN59,1.13,"I")
+107 IF 'IEN511
QUIT
+108 ;
+109 ; Loop through additional fields for the current segment (NODE) and
+110 ; call XFLDCODE to 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:1
+116 SET FLDIEN=$$GET1^DIQ(9002313.5112,BPSX_","_IEN511_",",.01,"I")
+117 SET BPS("X")=""
+118 DO XFLDCODE(NODE,FLDIEN,"GFS")
End DoDot:1
+119 ;
+120 QUIT
+121 ;
+122 ; Execute Get, Format, and/or Set MUMPS code for NCPDP Field
+123 ;
+124 ; Parameters: NODE - Segment Node
+125 ; FLDIEN - NCPDP Field Definitions IEN
+126 ; FLAG - If variable contains:
+127 ; "G" - Execute Get Code
+128 ; "F" - Execute Format Code
+129 ; "S" - Execute S Code
+130 ;
+131 ; When called by the DURPPS^BPSOSHF, DUR is also set and used
+132 ; by the SET logic for the DUR fields. This variable is newed
+133 ; by the calling routine
XFLDCODE(NODE,FLDIEN,FLAG) ;EP
+1 ;
+2 NEW FNODE,INDEX,MCODE,NCPVERS,X
+3 ;
+4 ; Check if record exists and FLAG variable is set correctly
+5 IF 'FLDIEN
DO IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XFLDCODE",$TEXT(+0))
QUIT
+6 IF FLAG=""
DO IMPOSS^BPSOSUE("DB,P","TI","FLAG null",,"XFLDCODE",$TEXT(+0))
QUIT
+7 ;
+8 ; get NCPDP version, default to vD.0
+9 SET NCPVERS=$GET(BPS("NCPDP","Version"))
+10 IF NCPVERS=""
SET NCPVERS="D0"
+11 ;
+12 ; Loop through GET CODE, D0 FORMAT (or FORMAT), SET CODE w-p fields and execute code
+13 FOR FNODE=10,20,25,30
Begin DoDot:1
+14 ; node 25 is FORMAT CODE for versions before D.0
IF FNODE=25
IF NCPVERS="D0"
QUIT
+15 ; node 20 is FORMAT CODE for vD.0
IF FNODE=20
IF NCPVERS'="D0"
QUIT
+16 IF FLAG'[$SELECT(FNODE=10:"G",FNODE=25!(FNODE=20):"F",FNODE=30:"S",1:"")
QUIT
+17 IF '$DATA(^BPSF(9002313.91,FLDIEN,FNODE,0))
DO IMPOSS^BPSOSUE("DB","TI","FLDIEN="_FLDIEN,"FNODE="_FNODE,"XFLDCODE",$TEXT(+0))
+18 ;
+19 ; If doing SET code and if this is not the header segment, add the ID prefix
+20 IF FNODE=30
IF NODE'=100
SET BPS("X")=$PIECE($GET(^BPSF(9002313.91,FLDIEN,5)),U,1)_BPS("X")
+21 ;
+22 ; Loop through the W-P field and execute each line
+23 SET INDEX=0
+24 FOR
SET INDEX=$ORDER(^BPSF(9002313.91,FLDIEN,FNODE,INDEX))
if 'INDEX
QUIT
Begin DoDot:2
+25 ; Get the code and xecute
+26 SET MCODE=$GET(^BPSF(9002313.91,FLDIEN,FNODE,INDEX,0))
+27 IF MCODE=""
QUIT
+28 IF $EXTRACT(MCODE,1)=";"
QUIT
+29 XECUTE MCODE
End DoDot:2
End DoDot:1
+30 ;
+31 QUIT
+32 ;
+33 ; Execute Special Code (for NCPDP Field within NCPDP Record)
+34 ; FORMAT = NCPDP Record Format IEN (9002313.92)
+35 ; NODE = Global node value (100,110,120,130,140)
+36 ; RECMIEN = Field Multiple IEN
XSPCCODE(FORMAT,NODE,RECMIEN) ;EP - Above and BPSOSHR
+1 ; BPS NCPDP FORMATS (#9002313.92)
+2 IF '$DATA(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0))
DO IMPOSS^BPSOSUE("DB,P","TI","no special code there to XECUTE","FORMAT="_FORMAT,"XSPCCODE",$TEXT(+0))
QUIT
+3 NEW INDEX,MCODE
+4 SET INDEX=0
+5 FOR
SET INDEX=$ORDER(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+6 ; Get the code and xecute
+7 SET MCODE=$GET(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX,0))
+8 IF MCODE=""
QUIT
+9 IF $EXTRACT(MCODE,1)=";"
QUIT
+10 XECUTE MCODE
End DoDot:1
+11 QUIT
+12 ;
