|
Last change
on this file since 949 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
782 bytes
|
| Rev | Line | |
|---|
| [613] | 1 | IBCEMU4 ;ALB/ESG - MRA UTILITIES ;25-OCT-2004
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**288**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | DENDUP(IBEOB) ; Denied for Duplicate Function
|
|---|
| 8 | ; Function returns true if MRA is Denied AND Reason code 18 is present (Duplicate claim/service)
|
|---|
| 9 | NEW IBX,IBM,LINE,DUP,ADJ
|
|---|
| 10 | S IBX=0,IBM=$G(^IBM(361.1,+$G(IBEOB),0))
|
|---|
| 11 | I $P(IBM,U,4)'=1 G DENDUPX ; not an MRA
|
|---|
| 12 | I $P(IBM,U,13)'=2 G DENDUPX ; not Denied
|
|---|
| 13 | ;
|
|---|
| 14 | ; check line item adjustments for reason code 18
|
|---|
| 15 | S LINE=0,DUP=0
|
|---|
| 16 | F S LINE=$O(^IBM(361.1,IBEOB,15,LINE)) Q:'LINE D Q:DUP
|
|---|
| 17 | . S ADJ=0
|
|---|
| 18 | . F S ADJ=$O(^IBM(361.1,IBEOB,15,LINE,1,ADJ)) Q:'ADJ D Q:DUP
|
|---|
| 19 | .. I $D(^IBM(361.1,IBEOB,15,LINE,1,ADJ,1,"B",18)) S DUP=1 Q
|
|---|
| 20 | .. Q
|
|---|
| 21 | . Q
|
|---|
| 22 | ;
|
|---|
| 23 | I DUP S IBX=1
|
|---|
| 24 | DENDUPX ;
|
|---|
| 25 | Q IBX
|
|---|
| 26 | ;
|
|---|
Note:
See
TracBrowser
for help on using the repository browser.
