- 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 Feb 18, 2025@23:18:05 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