BPSOSH3 ;AITC/MRD - Clinical Segment ;03/06/2025
;;1.0;E CLAIMS MGMT ENGINE;**40**;JUN 2004;Build 25
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
DXFIELDS ; Conditionally populate Diagnosis related fields.
;
; There will be a diagnosis (Dx) code only if:
; o The OPECC performed the RED Resubmit with Edits Action from
; the ECME User Screen.
; o The Pharmacist performed the DIA Action from the Work List.
; o The previous claim had a Dx code due to one of those reasons.
;
N CLAIM,COB,DXCODE,FIELDIEN,FILL,IEN57,IEN59,RXIEN
;
; NCPDP field 424, Diagnosis Code.
;
S FIELDIEN=$O(^BPSF(9002313.91,"B",424,""))
;
; First, pull the Dx code from the list of override fields. A
; value of "REMOVED" indicates that the claim should be resubmitted
; without using a previously sent diagnosis code (i.e. do not
; populate the Diagnosis related fields on this claim).
;
S DXCODE=$G(BPS("OVERRIDE","RX",1,FIELDIEN))
I DXCODE="REMOVED" Q
;
; If no Dx code was found in the list of override fields,
; then check the most recent previous claim, if any.
;
I DXCODE="" D
. S IEN59=+$G(BPS("RX",BPS(9002313.0201),"IEN59"))
. I IEN59="" Q
. S IEN57=$O(^BPSTL("B",IEN59,""),-1)
. I IEN57="" Q
. S CLAIM=$$GET1^DIQ(9002313.57,IEN57,3,"I")
. I CLAIM="" Q
. S DXCODE=$$GET1^DIQ(9002313.0201,1_","_CLAIM,424)
. S DXCODE=$TR($E(DXCODE,3,17)," ")
. Q
;
; If still no Dx code, then if this is a refill, look at
; the most recently submitted claim on the previous fill.
; If that claim has a Dx Code, send that on this claim.
;
I DXCODE="" D
. S IEN59=+$G(BPS("RX",BPS(9002313.0201),"IEN59"))
. I IEN59="" Q
. S FILL=$$GET1^DIQ(9002313.59,IEN59,9,"I")
. I +FILL=0 Q ; Quit if original fill.
. S FILL=FILL-1
. S RXIEN=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
. I RXIEN="" Q
. S COB=$$GET1^DIQ(9002313.59,IEN59,18,"I")
. I +COB=0 S COB=1
. S IEN59=RXIEN_"."_$TR($J(FILL,4)," ","0")_COB
. S CLAIM=$$GET1^DIQ(9002313.59,IEN59,3,"I")
. I CLAIM="" Q
. S DXCODE=$$GET1^DIQ(9002313.0201,1_","_CLAIM,424)
. S DXCODE=$TR($E(DXCODE,3,17)," ")
. Q
;
; If Dx code blank, then Quit; don't populate the Diagnosis fields.
;
I DXCODE="" Q
;
; NCPDP field 424, Diagnosis Code (strip any decimal point).
;
S BPS("RX",BPS(9002313.0201),"Diagnosis Code")=$TR(DXCODE,".")
D XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")
;
; NCPDP field 491, Diagnosis Code Count.
;
S FIELDIEN=$O(^BPSF(9002313.91,"B",491,""))
D XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")
;
; NCPDP field 492, Diagnosis Code Qualifier.
;
S FIELDIEN=$O(^BPSF(9002313.91,"B",492,""))
D XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")
;
Q
;
CLINICAL ; Conditionally create the Clinical Segment.
;
; The Clinical Segment is created only if there is a diagnosis code.
; There will be a diagnosis (Dx) code only if:
; o The OPECC performed the RED Resubmit with Edits Action from
; the ECME User Screen.
; o The Pharmacist performed the DIA Action from the Work List.
; o The previous claim had a Dx code due to one of those reasons.
; SEGREC is initiated in XLOOP^BPSOSH2.
;
N DXCODE,FLDDATA
;
; Pull the diagnosis (Dx) code from the claim. If blank, Quit.
;
S DXCODE=$G(BPS(9002313.0201,IEN(9002313.0201),424,"I"))
I DXCODE="" Q
;
; First add the segement ID.
;
S SEGREC=SEGREC_$C(28)_$$SEGID^BPSOSH2(230)
;
; NCPDP field 491, Diagnosis Code Count.
;
S FLDDATA=$G(BPS(9002313.0201,IEN(9002313.0201),491,"I"))
S SEGREC=SEGREC_$C(28)_FLDDATA
;
; NCPDP field 492, Diagnosis Code Qualifier.
;
S FLDDATA=$G(BPS(9002313.0201,IEN(9002313.0201),492,"I"))
S SEGREC=SEGREC_$C(28)_FLDDATA
;
; NCPDP field 424, Diagnosis Code.
;
S SEGREC=SEGREC_$C(28)_DXCODE
;
S DATAFND=1
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSH3 3840 printed Sep 23, 2025@19:27:53 Page 2
BPSOSH3 ;AITC/MRD - Clinical Segment ;03/06/2025
+1 ;;1.0;E CLAIMS MGMT ENGINE;**40**;JUN 2004;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
DXFIELDS ; Conditionally populate Diagnosis related fields.
+1 ;
+2 ; There will be a diagnosis (Dx) code only if:
+3 ; o The OPECC performed the RED Resubmit with Edits Action from
+4 ; the ECME User Screen.
+5 ; o The Pharmacist performed the DIA Action from the Work List.
+6 ; o The previous claim had a Dx code due to one of those reasons.
+7 ;
+8 NEW CLAIM,COB,DXCODE,FIELDIEN,FILL,IEN57,IEN59,RXIEN
+9 ;
+10 ; NCPDP field 424, Diagnosis Code.
+11 ;
+12 SET FIELDIEN=$ORDER(^BPSF(9002313.91,"B",424,""))
+13 ;
+14 ; First, pull the Dx code from the list of override fields. A
+15 ; value of "REMOVED" indicates that the claim should be resubmitted
+16 ; without using a previously sent diagnosis code (i.e. do not
+17 ; populate the Diagnosis related fields on this claim).
+18 ;
+19 SET DXCODE=$GET(BPS("OVERRIDE","RX",1,FIELDIEN))
+20 IF DXCODE="REMOVED"
QUIT
+21 ;
+22 ; If no Dx code was found in the list of override fields,
+23 ; then check the most recent previous claim, if any.
+24 ;
+25 IF DXCODE=""
Begin DoDot:1
+26 SET IEN59=+$GET(BPS("RX",BPS(9002313.0201),"IEN59"))
+27 IF IEN59=""
QUIT
+28 SET IEN57=$ORDER(^BPSTL("B",IEN59,""),-1)
+29 IF IEN57=""
QUIT
+30 SET CLAIM=$$GET1^DIQ(9002313.57,IEN57,3,"I")
+31 IF CLAIM=""
QUIT
+32 SET DXCODE=$$GET1^DIQ(9002313.0201,1_","_CLAIM,424)
+33 SET DXCODE=$TRANSLATE($EXTRACT(DXCODE,3,17)," ")
+34 QUIT
End DoDot:1
+35 ;
+36 ; If still no Dx code, then if this is a refill, look at
+37 ; the most recently submitted claim on the previous fill.
+38 ; If that claim has a Dx Code, send that on this claim.
+39 ;
+40 IF DXCODE=""
Begin DoDot:1
+41 SET IEN59=+$GET(BPS("RX",BPS(9002313.0201),"IEN59"))
+42 IF IEN59=""
QUIT
+43 SET FILL=$$GET1^DIQ(9002313.59,IEN59,9,"I")
+44 ; Quit if original fill.
IF +FILL=0
QUIT
+45 SET FILL=FILL-1
+46 SET RXIEN=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
+47 IF RXIEN=""
QUIT
+48 SET COB=$$GET1^DIQ(9002313.59,IEN59,18,"I")
+49 IF +COB=0
SET COB=1
+50 SET IEN59=RXIEN_"."_$TRANSLATE($JUSTIFY(FILL,4)," ","0")_COB
+51 SET CLAIM=$$GET1^DIQ(9002313.59,IEN59,3,"I")
+52 IF CLAIM=""
QUIT
+53 SET DXCODE=$$GET1^DIQ(9002313.0201,1_","_CLAIM,424)
+54 SET DXCODE=$TRANSLATE($EXTRACT(DXCODE,3,17)," ")
+55 QUIT
End DoDot:1
+56 ;
+57 ; If Dx code blank, then Quit; don't populate the Diagnosis fields.
+58 ;
+59 IF DXCODE=""
QUIT
+60 ;
+61 ; NCPDP field 424, Diagnosis Code (strip any decimal point).
+62 ;
+63 SET BPS("RX",BPS(9002313.0201),"Diagnosis Code")=$TRANSLATE(DXCODE,".")
+64 DO XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")
+65 ;
+66 ; NCPDP field 491, Diagnosis Code Count.
+67 ;
+68 SET FIELDIEN=$ORDER(^BPSF(9002313.91,"B",491,""))
+69 DO XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")
+70 ;
+71 ; NCPDP field 492, Diagnosis Code Qualifier.
+72 ;
+73 SET FIELDIEN=$ORDER(^BPSF(9002313.91,"B",492,""))
+74 DO XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")
+75 ;
+76 QUIT
+77 ;
CLINICAL ; Conditionally create the Clinical Segment.
+1 ;
+2 ; The Clinical Segment is created only if there is a diagnosis code.
+3 ; There will be a diagnosis (Dx) code only if:
+4 ; o The OPECC performed the RED Resubmit with Edits Action from
+5 ; the ECME User Screen.
+6 ; o The Pharmacist performed the DIA Action from the Work List.
+7 ; o The previous claim had a Dx code due to one of those reasons.
+8 ; SEGREC is initiated in XLOOP^BPSOSH2.
+9 ;
+10 NEW DXCODE,FLDDATA
+11 ;
+12 ; Pull the diagnosis (Dx) code from the claim. If blank, Quit.
+13 ;
+14 SET DXCODE=$GET(BPS(9002313.0201,IEN(9002313.0201),424,"I"))
+15 IF DXCODE=""
QUIT
+16 ;
+17 ; First add the segement ID.
+18 ;
+19 SET SEGREC=SEGREC_$CHAR(28)_$$SEGID^BPSOSH2(230)
+20 ;
+21 ; NCPDP field 491, Diagnosis Code Count.
+22 ;
+23 SET FLDDATA=$GET(BPS(9002313.0201,IEN(9002313.0201),491,"I"))
+24 SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
+25 ;
+26 ; NCPDP field 492, Diagnosis Code Qualifier.
+27 ;
+28 SET FLDDATA=$GET(BPS(9002313.0201,IEN(9002313.0201),492,"I"))
+29 SET SEGREC=SEGREC_$CHAR(28)_FLDDATA
+30 ;
+31 ; NCPDP field 424, Diagnosis Code.
+32 ;
+33 SET SEGREC=SEGREC_$CHAR(28)_DXCODE
+34 ;
+35 SET DATAFND=1
+36 ;
+37 QUIT
+38 ;
