VistA-WorldVistAEHR/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSHR.m

124 lines
4.9 KiB
Mathematica

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