| [613] | 1 | IB20P275 ;WOIFO/SS - POST INIT ROUTINE FOR IB*2*275 ;11-MAY-04
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**275**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | POST ; adding charge removal reason entries if not there
|
|---|
| 7 | N IBX,IBT,IBY,X,Y,DIC,DO
|
|---|
| 8 | D ADDAUTO
|
|---|
| 9 | D ADDCRR
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | ADDAUTO ; need to add charge removal reasons
|
|---|
| 13 | N IBX,IBT,IBY,DIC,Y,X
|
|---|
| 14 | F IBX=1:1 S IBY=$P($T(AUTO+IBX),";",3,99) Q:IBY="" S IBT=$P(IBY,";") I '$O(^IBE(354.2,"B",IBT,0)) K DO D
|
|---|
| 15 | . S DIC="^IBE(354.2,",DIC(0)="",X=IBT,DIC("DR")=$P(IBY,";",2,5)
|
|---|
| 16 | . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Exemption Reason File: "_IBT)
|
|---|
| 17 | Q
|
|---|
| 18 | ADDCRR ; add charge removal reasons
|
|---|
| 19 | N IBX,IBT,IBY,DIC,Y,X
|
|---|
| 20 | F IBX=1:1 S IBY=$P($T(CRR+IBX),";",3,99) Q:IBY="" S IBT=$P(IBY,";") I '$O(^IBE(350.3,"B",IBT,0)) K DO D
|
|---|
| 21 | . S DIC="^IBE(350.3,",DIC(0)="",X=IBT,DIC("DR")=$P(IBY,";",2,3)
|
|---|
| 22 | . D FILE^DICN I Y>0 D BMES^XPDUTL(" --> Added Charge Removal Reasons: "_IBT)
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | ;
|
|---|
| 26 | AUTO ; Exemption Reasons to add in #354.2
|
|---|
| 27 | ;;FORMER POW;.02///Patient is a former Prisoner Of War;.03///COPAY INCOME EXEMPTION;.04///EXEMPT;.05///80
|
|---|
| 28 | ;;UNEMPLOYABLE VETERAN;.02///Patient is an unemployable veteran;.03///COPAY INCOME EXEMPTION;.04///EXEMPT;.05///90
|
|---|
| 29 | ;;
|
|---|
| 30 | ;
|
|---|
| 31 | CRR ; charge removal reasons to add in #350.3
|
|---|
| 32 | ;;RX FOR FORMER POW;.02///POW;.03///RX
|
|---|
| 33 | ;;RX FOR UNEMPLOYABLE VETERAN;.02///UNEMPL;.03///RX
|
|---|
| 34 | ;;
|
|---|
| 35 | ;
|
|---|
