BPSOSHR ;BHAM ISC/SD/lwj/DLF - Format conversion for reversals ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,2,5**;JUN 2004;Build 45
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine was originally used by IHS to reformat reversal claims
; into version 5.1 if the original billing request was version 3x.
; For that purpose, this routine is no longer needed. However,
; it also executes the special code fields so for that reason, it
; has not been removed. We also may need to do this if we change
; from version 5.1 to some other version, such as version 8, in the
; future.
;
; NOTE: There is a problem with special code if it relies on BPS array
; values, such as BPS("Site","NCPDP") since those variables will not
; be defined at this point. So, the only special code that will
; work are hard-coded values or executes of a procedure. If executing
; a procedure, it also needs to not rely on BPS array elements or needs
; to distinquish between billing requests and reversals.
Q
;
; Input
; BPSFORM - Reversal payer sheet IEN
; CLAIMIEN - Original claim IEN
; POS - Multiple from original claim
;
; Input/Output
; TMP is the array originally created in BPSECA8. Since it is quite
; large, we are not passing it into here. It will be modified by
; this routine.
;
REFORM(BPSFORM,CLAIMIEN,POS) ;
;
; Validate parameters
I $G(BPSFORM)="" Q
I $G(CLAIMIEN)="" Q
I $G(POS)="" Q
;
; Initialize variables
N FLDIEN,PMODE,ORDER,RECMIEN,FIELD,NODE
;
; First go through the header fields. The original IHS logic was only
; checking four specific fields. Of these, I removed:
; 109 (Transaction Count) - Always 1 for reversals and it does
; not make sense for this to be determined by special code.
; 201 (Service Provider ID) - The logic currently implemented
; relies on BPS array elements that are not defined here so this
; was getting set to NULL when it needed to be set. In addition
; I compared reversal and request (11/30/2006) and this value is
; always the same for both so reversals will get the right value
; from the request.
; 202 (Service Provider ID Qualifier) - It does not make sense
; to do this field if we are not doing field 201.
;
; So that leaves 110 (Software Vendor/Certification ID), which is needed
; by the WEBMD reversal test payer sheet.
;
; Kept looping structure in case other fields are added later
;
S NODE=100,ORDER=0
F S ORDER=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER)) Q:'ORDER D
. S RECMIEN=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER,0))
. I 'RECMIEN Q
. S FLDIEN=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,2)
. S FIELD=$P($G(^BPSF(9002313.91,FLDIEN,0)),U)
. I FIELD'=110 Q
. ;
. ; Check to see if the format has special code. If not, quit
. ; If we change versions (5x to ??), we made need to execute FORMAT
. ; code no matter what, but for now, only do if there is special
. ; code.
. S PMODE=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,3)
. I PMODE'="X" Q
. ;
. ; If special code, get the value, format it and store it in TMP
. D XSPCCODE^BPSOSCF(BPSFORM,NODE,RECMIEN)
. D FORMAT(NODE,FLDIEN)
. S TMP(9002313.02,CLAIMIEN,FIELD,"I")=BPS("X")
;
; Now reformat the "detail" portion of the claim. For now, the only
; segment we are going to look at is 130, which is the claim segment
; If other reversal formats become available, and they require other
; segments - this section will have to change. Since the claim
; segment full of optional fields, we wil read through the format
; and take it a field at a time.
S NODE=130,ORDER=0
F S ORDER=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER)) Q:'ORDER D
. S RECMIEN=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER,0))
. I 'RECMIEN Q
. S FLDIEN=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,2)
. S FIELD=$P($G(^BPSF(9002313.91,FLDIEN,0)),U)
. I FIELD=111 Q ; Never do Segment Indentifier
. ;
. ; Check to see if the format has special code. If not, quit
. ; If we change versions (5x to ??), we made need to execute FORMAT
. ; code no matter what, but for now, only do if there is special
. ; code.
. S PMODE=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,3)
. I PMODE'="X" Q
. ;
. ; If special code, get the value, format it and store it in TMP
. D XSPCCODE^BPSOSCF(BPSFORM,NODE,RECMIEN)
. D FORMAT(NODE,FLDIEN)
. S TMP(9002313.0201,POS_","_CLAIMIEN,FIELD,"I")=BPS("X")
Q
;
; FORMAT will format the data based on the FORMAT code in BPS NCPDP
; FIELD DEFS
FORMAT(NODE,FLDIEN) ;
N INDEX,MCODE,QUAL
;
; Loop through format code and format the data
S INDEX=0
F S INDEX=$O(^BPSF(9002313.91,FLDIEN,25,INDEX)) Q:'+INDEX D
. S MCODE=$G(^BPSF(9002313.91,FLDIEN,25,INDEX,0))
. I MCODE="" Q
. I $E(MCODE,1)=";" Q
. X MCODE
;
; If node not equal to 100, append qualifier
I NODE'=100 D
. S QUAL=$P(^BPSF(9002313.91,FLDIEN,5),"^",1)
. S BPS("X")=QUAL_BPS("X")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSHR 5158 printed Sep 23, 2025@19:27:55 Page 2
BPSOSHR ;BHAM ISC/SD/lwj/DLF - Format conversion for reversals ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5**;JUN 2004;Build 45
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine was originally used by IHS to reformat reversal claims
+5 ; into version 5.1 if the original billing request was version 3x.
+6 ; For that purpose, this routine is no longer needed. However,
+7 ; it also executes the special code fields so for that reason, it
+8 ; has not been removed. We also may need to do this if we change
+9 ; from version 5.1 to some other version, such as version 8, in the
+10 ; future.
+11 ;
+12 ; NOTE: There is a problem with special code if it relies on BPS array
+13 ; values, such as BPS("Site","NCPDP") since those variables will not
+14 ; be defined at this point. So, the only special code that will
+15 ; work are hard-coded values or executes of a procedure. If executing
+16 ; a procedure, it also needs to not rely on BPS array elements or needs
+17 ; to distinquish between billing requests and reversals.
+18 QUIT
+19 ;
+20 ; Input
+21 ; BPSFORM - Reversal payer sheet IEN
+22 ; CLAIMIEN - Original claim IEN
+23 ; POS - Multiple from original claim
+24 ;
+25 ; Input/Output
+26 ; TMP is the array originally created in BPSECA8. Since it is quite
+27 ; large, we are not passing it into here. It will be modified by
+28 ; this routine.
+29 ;
REFORM(BPSFORM,CLAIMIEN,POS) ;
+1 ;
+2 ; Validate parameters
+3 IF $GET(BPSFORM)=""
QUIT
+4 IF $GET(CLAIMIEN)=""
QUIT
+5 IF $GET(POS)=""
QUIT
+6 ;
+7 ; Initialize variables
+8 NEW FLDIEN,PMODE,ORDER,RECMIEN,FIELD,NODE
+9 ;
+10 ; First go through the header fields. The original IHS logic was only
+11 ; checking four specific fields. Of these, I removed:
+12 ; 109 (Transaction Count) - Always 1 for reversals and it does
+13 ; not make sense for this to be determined by special code.
+14 ; 201 (Service Provider ID) - The logic currently implemented
+15 ; relies on BPS array elements that are not defined here so this
+16 ; was getting set to NULL when it needed to be set. In addition
+17 ; I compared reversal and request (11/30/2006) and this value is
+18 ; always the same for both so reversals will get the right value
+19 ; from the request.
+20 ; 202 (Service Provider ID Qualifier) - It does not make sense
+21 ; to do this field if we are not doing field 201.
+22 ;
+23 ; So that leaves 110 (Software Vendor/Certification ID), which is needed
+24 ; by the WEBMD reversal test payer sheet.
+25 ;
+26 ; Kept looping structure in case other fields are added later
+27 ;
+28 SET NODE=100
SET ORDER=0
+29 FOR
SET ORDER=$ORDER(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER))
if 'ORDER
QUIT
Begin DoDot:1
+30 SET RECMIEN=$ORDER(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER,0))
+31 IF 'RECMIEN
QUIT
+32 SET FLDIEN=$PIECE($GET(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,2)
+33 SET FIELD=$PIECE($GET(^BPSF(9002313.91,FLDIEN,0)),U)
+34 IF FIELD'=110
QUIT
+35 ;
+36 ; Check to see if the format has special code. If not, quit
+37 ; If we change versions (5x to ??), we made need to execute FORMAT
+38 ; code no matter what, but for now, only do if there is special
+39 ; code.
+40 SET PMODE=$PIECE($GET(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,3)
+41 IF PMODE'="X"
QUIT
+42 ;
+43 ; If special code, get the value, format it and store it in TMP
+44 DO XSPCCODE^BPSOSCF(BPSFORM,NODE,RECMIEN)
+45 DO FORMAT(NODE,FLDIEN)
+46 SET TMP(9002313.02,CLAIMIEN,FIELD,"I")=BPS("X")
End DoDot:1
+47 ;
+48 ; Now reformat the "detail" portion of the claim. For now, the only
+49 ; segment we are going to look at is 130, which is the claim segment
+50 ; If other reversal formats become available, and they require other
+51 ; segments - this section will have to change. Since the claim
+52 ; segment full of optional fields, we wil read through the format
+53 ; and take it a field at a time.
+54 SET NODE=130
SET ORDER=0
+55 FOR
SET ORDER=$ORDER(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER))
if 'ORDER
QUIT
Begin DoDot:1
+56 SET RECMIEN=$ORDER(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER,0))
+57 IF 'RECMIEN
QUIT
+58 SET FLDIEN=$PIECE($GET(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,2)
+59 SET FIELD=$PIECE($GET(^BPSF(9002313.91,FLDIEN,0)),U)
+60 ; Never do Segment Indentifier
IF FIELD=111
QUIT
+61 ;
+62 ; Check to see if the format has special code. If not, quit
+63 ; If we change versions (5x to ??), we made need to execute FORMAT
+64 ; code no matter what, but for now, only do if there is special
+65 ; code.
+66 SET PMODE=$PIECE($GET(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,3)
+67 IF PMODE'="X"
QUIT
+68 ;
+69 ; If special code, get the value, format it and store it in TMP
+70 DO XSPCCODE^BPSOSCF(BPSFORM,NODE,RECMIEN)
+71 DO FORMAT(NODE,FLDIEN)
+72 SET TMP(9002313.0201,POS_","_CLAIMIEN,FIELD,"I")=BPS("X")
End DoDot:1
+73 QUIT
+74 ;
+75 ; FORMAT will format the data based on the FORMAT code in BPS NCPDP
+76 ; FIELD DEFS
FORMAT(NODE,FLDIEN) ;
+1 NEW INDEX,MCODE,QUAL
+2 ;
+3 ; Loop through format code and format the data
+4 SET INDEX=0
+5 FOR
SET INDEX=$ORDER(^BPSF(9002313.91,FLDIEN,25,INDEX))
if '+INDEX
QUIT
Begin DoDot:1
+6 SET MCODE=$GET(^BPSF(9002313.91,FLDIEN,25,INDEX,0))
+7 IF MCODE=""
QUIT
+8 IF $EXTRACT(MCODE,1)=";"
QUIT
+9 XECUTE MCODE
End DoDot:1
+10 ;
+11 ; If node not equal to 100, append qualifier
+12 IF NODE'=100
Begin DoDot:1
+13 SET QUAL=$PIECE(^BPSF(9002313.91,FLDIEN,5),"^",1)
+14 SET BPS("X")=QUAL_BPS("X")
End DoDot:1
+15 QUIT
