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**;JUN 2004;Build 25
;;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 = 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,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
. ;
. ; Get the pointer to the BPS NCPDP FIELD DEFS table
. 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)
. ;
. ; Corrupt or erroneous format file
. 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 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, via the action RED / Resubmit with
; Edits, to add to the claim fields not on the payer sheet.
; 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 7869 printed Sep 23, 2025@19:27:51 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**;JUN 2004;Build 25
+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 = 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,OVERRIDE,PMODE,RECMIEN,BPSX
+7 ;
+8 ; quit If the payer sheet doesn't have the segment
+9 IF NODE'=230
IF '$DATA(^BPSF(9002313.92,FORMAT,NODE,0))
QUIT
+10 ;
+11 ; VA doesn't do these segments
+12 IF ",300,290,280,270,260,250,240,220,210,200,170,140,"[(","_NODE_",")
QUIT
+13 ;
+14 ; Per NCPDP standard, eligibility doesn't support segments listed below
+15 IF BPS("Transaction Code")="E1"
IF ",290,280,270,260,250,230,220,210,200,190,180,170,160,130,"[(","_NODE_",")
QUIT
+16 ;
+17 ; For COB, if the payer sequence is primary, then quit and don't output the COB fields
+18 IF NODE=160
IF $$COB59^BPSUTIL2(+$GET(BPS("RX",BPS(9002313.0201),"IEN59")))=1
QUIT
+19 ;
+20 ; COB processing is handled differently
+21 IF NODE=160
DO COB^BPSOSHF(FORMAT,NODE,MEDN)
QUIT
+22 ;
+23 ; DUR is handled differently since it is repeating
+24 IF NODE=180
DO DURPPS^BPSOSHF(FORMAT,NODE,MEDN)
QUIT
+25 ;
+26 ; The Diagnosis related fields will be populated only if the user
+27 ; entered a diagnosis code via the RED Action (ECME User Screen) or
+28 ; the DIA Action (Pharmacist Worklist).
+29 IF NODE=230
DO DXFIELDS^BPSOSH3
QUIT
+30 ;
+31 ; Loop through the fields in the segment
+32 SET ORDER=0
+33 FOR
SET ORDER=$ORDER(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER))
if 'ORDER
QUIT
Begin DoDot:1
+34 ;
+35 ; Get the pointer to the BPS NCPDP FIELD DEFS table
+36 SET RECMIEN=$ORDER(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER,0))
+37 IF 'RECMIEN
DO IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$TEXT(+0))
QUIT
+38 SET MDATA=^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)
+39 ;
+40 ; Corrupt or erroneous format file
+41 SET FLDIEN=$PIECE(MDATA,U,2)
+42 IF 'FLDIEN
QUIT
+43 ;
+44 ; BPS NCPDP FIELD DEFS (#9002313.91)
SET FLDINFO=$GET(^BPSF(9002313.91,FLDIEN,0))
+45 IF FLDINFO=""
DO IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XLOOP",$TEXT(+0))
QUIT
+46 ;
+47 ; Quit for 111-AM Segment Identification (standard field for each segment)
+48 ; 478-H7 Other Amount Claimed Submitted Count (handled with
+49 ; 479-H8 Other Amount Claimed Submitted Qualifier field 480)
+50 SET BPSX=$PIECE(FLDINFO,U)
+51 IF ",111,478,479,"[(","_BPSX_",")
QUIT
+52 ;
+53 ; Set override value (may not be defined so override will be null)
+54 IF $DATA(MEDN)
SET OVERRIDE=$GET(BPS("OVERRIDE","RX",MEDN,FLDIEN))
+55 IF '$TEST
SET OVERRIDE=$GET(BPS("OVERRIDE",FLDIEN))
+56 ;
+57 ; Get processing mode (S-Standard (default), X-Special Code)
+58 SET PMODE=$PIECE(MDATA,U,3)
+59 IF PMODE=""
SET PMODE="S"
+60 ;
+61 ; Default FLAG and value being computed
+62 SET FLAG="GFS"
+63 SET BPS("X")=""
+64 ;
+65 ; If there is an override, set BPS("X") to it and
+66 ; only do Format and Set code
+67 IF OVERRIDE]""
SET FLAG="FS"
SET BPS("X")=OVERRIDE
+68 ;
+69 ; If Special Code mode is set, execute special code instead
+70 ; of field's Get code and change Flag to FS so Format and
+71 ; Set code is still done but not GET code
+72 IF PMODE="X"
IF OVERRIDE=""
Begin DoDot:2
+73 SET FLAG="FS"
+74 DO XSPCCODE(FORMAT,NODE,RECMIEN)
End DoDot:2
+75 ;
+76 ; Call XFLDCODE to do processing based on FLAG setting
+77 DO XFLDCODE(NODE,FLDIEN,FLAG)
End DoDot:1
+78 ;
+79 ; If the current segment is 130/Claim, populate field 460-ET
+80 ; QUANTITY PRESCRIBED if it's not already populated.
+81 ;
+82 IF NODE=130
Begin DoDot:1
+83 IF $$GET1^DIQ(9002313.0201,BPS(9002313.0201)_","_BPS(9002313.02),460,"I")'=""
QUIT
+84 SET FLDIEN=$ORDER(^BPSF(9002313.91,"B",460,""))
+85 IF FLDIEN=""
QUIT
+86 DO XFLDCODE(NODE,FLDIEN,"GFS")
+87 QUIT
End DoDot:1
+88 ;
+89 ; The user has the ability, via the action RED / Resubmit with
+90 ; Edits, to add to the claim fields not on the payer sheet.
+91 ; Any fields to be added to the claim are stored in the file
+92 ; BPS NCPDP OVERRIDE.
+93 ;
+94 ; Determine the transaction from the claim. Determine
+95 ; override, and Quit if none. Field 1.13 is NCPDP OVERRIDES,
+96 ; ptr to 9002313.511.
+97 ;
+98 SET IEN59=$$CLAIM59^BPSUTIL2(BPS(9002313.02))
+99 SET IEN511=$$GET1^DIQ(9002313.59,IEN59,1.13,"I")
+100 IF 'IEN511
QUIT
+101 ;
+102 ; Loop through additional fields for the current segment (NODE) and
+103 ; call XFLDCODE to add to the claim.
+104 ;
+105 SET NODEIEN=$ORDER(^BPSF(9002313.9,"C",NODE,""))
+106 IF 'NODEIEN
QUIT
+107 SET BPSX=""
+108 FOR
SET BPSX=$ORDER(^BPS(9002313.511,IEN511,2,"SEG",NODEIEN,BPSX))
if BPSX=""
QUIT
Begin DoDot:1
+109 SET FLDIEN=$$GET1^DIQ(9002313.5112,BPSX_","_IEN511_",",.01,"I")
+110 SET BPS("X")=""
+111 DO XFLDCODE(NODE,FLDIEN,"GFS")
End DoDot:1
+112 ;
+113 QUIT
+114 ;
+115 ; Execute Get, Format and/or Set MUMPS code for NCPDP Field
+116 ;
+117 ; Parameters: NODE - Segment Node
+118 ; FLDIEN - NCPDP Field Definitions IEN
+119 ; FLAG - If variable contains:
+120 ; "G" - Execute Get Code
+121 ; "F" - Execute Format Code
+122 ; "S" - Execute S Code
+123 ;
+124 ; When called by the DURPPS^BPSOSHF, DUR is also set and used
+125 ; by the SET logic for the DUR fields. This variable is newed
+126 ; 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 ;
