BPSOSH3.m

BPSOSH3 ;AITC/MRD - Clinical Segment ;03/06/2025

 ;;1.0;E CLAIMS MGMT ENGINE;**40,41**;JUN 2004;Build 11

 ;;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 Reject

 ;     Information Screen.

 ;   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 Reject

 ;     Information Screen.

 ;   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

 ;

PREG ; Conditionally populate the field Pregnancy Indicator.

 ;

 ; There will be a pregnancy indicator only if the Pharmacist performed

 ; the PRG Action from the Reject Information Screen or the previous

 ; claim had this field populated.

 ;

 N CLAIM,FIELDIEN,IEN57,IEN59,PREG,RXIEN

 ;

 ; NCPDP field 335, Pregnancy Indicator.

 ;

 S FIELDIEN=$O(^BPSF(9002313.91,"B",335,""))

 ;

 ; First, pull the pregnancy indicator from the list of override fields.

 ;

 S PREG=$G(BPS("OVERRIDE",FIELDIEN))

 ;

 ; If no pregnancy indicator was found in the list of override fields,

 ; then check the most recent previous claim, if any.

 ;

 I PREG="" D

 . S IEN59=+$G(BPS("RX",1,"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 PREG=$TR($E($$GET1^DIQ(9002313.02,CLAIM,335),3)," ")

 . Q

 ;

 ; Quit if no value found.

 ;

 I PREG="" Q

 ;

 ; NCPDP field 335, Pregnancy Indicator.

 ;

 S BPS("Patient","Pregnancy Indicator")=PREG

 D XFLDCODE^BPSOSCF(110,FIELDIEN,"GFS")

 ;

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPSOSH3   4986     printed  Jan 29, 2026@14:50:24                                                                                                                                                                                                     Page 2

BPSOSH3   ;AITC/MRD - Clinical Segment ;03/06/2025

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**40,41**;JUN 2004;Build 11

 +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 Reject

 +6       ;     Information Screen.

 +7       ;   o The previous claim had a Dx code due to one of those reasons.

 +8       ;

 +9        NEW CLAIM,COB,DXCODE,FIELDIEN,FILL,IEN57,IEN59,RXIEN

 +10      ;

 +11      ; NCPDP field 424, Diagnosis Code.

 +12      ;

 +13       SET FIELDIEN=$ORDER(^BPSF(9002313.91,"B",424,""))

 +14      ;

 +15      ; First, pull the Dx code from the list of override fields.  A

 +16      ; value of "REMOVED" indicates that the claim should be resubmitted

 +17      ; without using a previously sent diagnosis code (i.e. do not

 +18      ; populate the Diagnosis related fields on this claim).

 +19      ;

 +20       SET DXCODE=$GET(BPS("OVERRIDE","RX",1,FIELDIEN))

 +21       IF DXCODE="REMOVED"

               QUIT 

 +22      ;

 +23      ; If no Dx code was found in the list of override fields,

 +24      ; then check the most recent previous claim, if any.

 +25      ;

 +26       IF DXCODE=""

               Begin DoDot:1

 +27               SET IEN59=+$GET(BPS("RX",BPS(9002313.0201),"IEN59"))

 +28               IF IEN59=""

                       QUIT 

 +29               SET IEN57=$ORDER(^BPSTL("B",IEN59,""),-1)

 +30               IF IEN57=""

                       QUIT 

 +31               SET CLAIM=$$GET1^DIQ(9002313.57,IEN57,3,"I")

 +32               IF CLAIM=""

                       QUIT 

 +33               SET DXCODE=$$GET1^DIQ(9002313.0201,1_","_CLAIM,424)

 +34               SET DXCODE=$TRANSLATE($EXTRACT(DXCODE,3,17)," ")

 +35               QUIT 

               End DoDot:1

 +36      ;

 +37      ; If still no Dx code, then if this is a refill, look at

 +38      ; the most recently submitted claim on the previous fill.

 +39      ; If that claim has a Dx Code, send that on this claim.

 +40      ;

 +41       IF DXCODE=""

               Begin DoDot:1

 +42               SET IEN59=+$GET(BPS("RX",BPS(9002313.0201),"IEN59"))

 +43               IF IEN59=""

                       QUIT 

 +44               SET FILL=$$GET1^DIQ(9002313.59,IEN59,9,"I")

 +45      ; Quit if original fill.

                   IF +FILL=0

                       QUIT 

 +46               SET FILL=FILL-1

 +47               SET RXIEN=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")

 +48               IF RXIEN=""

                       QUIT 

 +49               SET COB=$$GET1^DIQ(9002313.59,IEN59,18,"I")

 +50               IF +COB=0

                       SET COB=1

 +51               SET IEN59=RXIEN_"."_$TRANSLATE($JUSTIFY(FILL,4)," ","0")_COB

 +52               SET CLAIM=$$GET1^DIQ(9002313.59,IEN59,3,"I")

 +53               IF CLAIM=""

                       QUIT 

 +54               SET DXCODE=$$GET1^DIQ(9002313.0201,1_","_CLAIM,424)

 +55               SET DXCODE=$TRANSLATE($EXTRACT(DXCODE,3,17)," ")

 +56               QUIT 

               End DoDot:1

 +57      ;

 +58      ; If Dx code blank, then Quit; don't populate the Diagnosis fields.

 +59      ;

 +60       IF DXCODE=""

               QUIT 

 +61      ;

 +62      ; NCPDP field 424, Diagnosis Code (strip any decimal point).

 +63      ;

 +64       SET BPS("RX",BPS(9002313.0201),"Diagnosis Code")=$TRANSLATE(DXCODE,".")

 +65       DO XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")

 +66      ;

 +67      ; NCPDP field 491, Diagnosis Code Count.

 +68      ;

 +69       SET FIELDIEN=$ORDER(^BPSF(9002313.91,"B",491,""))

 +70       DO XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")

 +71      ;

 +72      ; NCPDP field 492, Diagnosis Code Qualifier.

 +73      ;

 +74       SET FIELDIEN=$ORDER(^BPSF(9002313.91,"B",492,""))

 +75       DO XFLDCODE^BPSOSCF(230,FIELDIEN,"GFS")

 +76      ;

 +77       QUIT 

 +78      ;

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 Reject

 +7       ;     Information Screen.

 +8       ;   o The previous claim had a Dx code due to one of those reasons.

 +9       ; SEGREC is initiated in XLOOP^BPSOSH2.

 +10      ;

 +11       NEW DXCODE,FLDDATA

 +12      ;

 +13      ; Pull the diagnosis (Dx) code from the claim.  If blank, Quit.

 +14      ;

 +15       SET DXCODE=$GET(BPS(9002313.0201,IEN(9002313.0201),424,"I"))

 +16       IF DXCODE=""

               QUIT 

 +17      ;

 +18      ; First add the segement ID.

 +19      ;

 +20       SET SEGREC=SEGREC_$CHAR(28)_$$SEGID^BPSOSH2(230)

 +21      ;

 +22      ; NCPDP field 491, Diagnosis Code Count.

 +23      ;

 +24       SET FLDDATA=$GET(BPS(9002313.0201,IEN(9002313.0201),491,"I"))

 +25       SET SEGREC=SEGREC_$CHAR(28)_FLDDATA

 +26      ;

 +27      ; NCPDP field 492, Diagnosis Code Qualifier.

 +28      ;

 +29       SET FLDDATA=$GET(BPS(9002313.0201,IEN(9002313.0201),492,"I"))

 +30       SET SEGREC=SEGREC_$CHAR(28)_FLDDATA

 +31      ;

 +32      ; NCPDP field 424, Diagnosis Code.

 +33      ;

 +34       SET SEGREC=SEGREC_$CHAR(28)_DXCODE

 +35      ;

 +36       SET DATAFND=1

 +37      ;

 +38       QUIT 

 +39      ;

PREG      ; Conditionally populate the field Pregnancy Indicator.

 +1       ;

 +2       ; There will be a pregnancy indicator only if the Pharmacist performed

 +3       ; the PRG Action from the Reject Information Screen or the previous

 +4       ; claim had this field populated.

 +5       ;

 +6        NEW CLAIM,FIELDIEN,IEN57,IEN59,PREG,RXIEN

 +7       ;

 +8       ; NCPDP field 335, Pregnancy Indicator.

 +9       ;

 +10       SET FIELDIEN=$ORDER(^BPSF(9002313.91,"B",335,""))

 +11      ;

 +12      ; First, pull the pregnancy indicator from the list of override fields.

 +13      ;

 +14       SET PREG=$GET(BPS("OVERRIDE",FIELDIEN))

 +15      ;

 +16      ; If no pregnancy indicator was found in the list of override fields,

 +17      ; then check the most recent previous claim, if any.

 +18      ;

 +19       IF PREG=""

               Begin DoDot:1

 +20               SET IEN59=+$GET(BPS("RX",1,"IEN59"))

 +21               IF IEN59=""

                       QUIT 

 +22               SET IEN57=$ORDER(^BPSTL("B",IEN59,""),-1)

 +23               IF IEN57=""

                       QUIT 

 +24               SET CLAIM=$$GET1^DIQ(9002313.57,IEN57,3,"I")

 +25               IF CLAIM=""

                       QUIT 

 +26               SET PREG=$TRANSLATE($EXTRACT($$GET1^DIQ(9002313.02,CLAIM,335),3)," ")

 +27               QUIT 

               End DoDot:1

 +28      ;

 +29      ; Quit if no value found.

 +30      ;

 +31       IF PREG=""

               QUIT 

 +32      ;

 +33      ; NCPDP field 335, Pregnancy Indicator.

 +34      ;

 +35       SET BPS("Patient","Pregnancy Indicator")=PREG

 +36       DO XFLDCODE^BPSOSCF(110,FIELDIEN,"GFS")

 +37      ;

 +38       QUIT 

 +39      ;