| 1 | IBCF331 ;ALB/ARH - UB92 HCFA-1450 (GATHER CODES CONT) ;25-AUG-1993
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,210,309,389**; 21-MAR-94;Build 6
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | DX ;additional dx codes (ie more than 9 on bill)
|
|---|
| 7 | D SET^IBCSC4D(IBIFN,"",.IBARRAY) G:$P(IBARRAY,U,2)'>9 RX
|
|---|
| 8 | S IBX=+$P(IBARRAY,U,2)-9+2 D SPACE
|
|---|
| 9 | S IBZ="" D SET2
|
|---|
| 10 | S IBZ="ADDITIONAL DIAGNOSIS CODES:" D SET2
|
|---|
| 11 | S IBX=0 F IBI=1:1 S IBX=$O(IBARRAY(IBX)) Q:IBX="" I IBI>9 D
|
|---|
| 12 | . S IBY=$$ICD9^IBACSV(+$G(IBARRAY(IBX)),$$BDATE^IBACSV(+IBIFN)) Q:IBY=""
|
|---|
| 13 | . S IBZ=$P(IBY,U)_$J(" ",(10-$L($P(IBY,U))))_$P(IBY,U,3) D SET2
|
|---|
| 14 | ;
|
|---|
| 15 | RX ;add rx refills
|
|---|
| 16 | D SET^IBCSC5A(IBIFN,.IBARRAY) G:'$P(IBARRAY,U,2) PD
|
|---|
| 17 | S IBX=+$P(IBARRAY,U,2)+2 D SPACE
|
|---|
| 18 | S IBZ="" D SET2
|
|---|
| 19 | S IBZ="PRESCRIPTION REFILLS:" D SET2
|
|---|
| 20 | S IBX=0 F S IBX=$O(IBARRAY(IBX)) Q:IBX="" S IBY=0 F S IBY=$O(IBARRAY(IBX,IBY)) Q:'IBY S IBLN=IBARRAY(IBX,IBY) D
|
|---|
| 21 | . D ZERO^IBRXUTL(+$P(IBLN,U,2))
|
|---|
| 22 | . S IBZ=IBX_$J(" ",(11-$L(IBX)))_" "_$J($S($P(IBLN,U,6):"$"_$FN($P(IBLN,U,6),",",2),1:""),10)_" "_$J($$FMTE^XLFDT(IBY,2),8)_" "_$G(^TMP($J,"IBDRUG",+$P(IBLN,U,2),.01)) D SET2
|
|---|
| 23 | . S IBZ="",IBZ=$S(+$P(IBLN,U,4):"QTY: "_$P(IBLN,U,4)_" ",1:"")_$S(+$P(IBLN,U,3):"for "_$P(IBLN,U,3)_" days supply ",1:"") I IBZ'="" S IBZ=$J(" ",35)_IBZ D SET2
|
|---|
| 24 | . S IBZ="",IBZ=$S($P(IBLN,U,5)'="":"NDC #: "_$P(IBLN,U,5),1:"") I IBZ'="" S IBZ=$J(" ",35)_IBZ D SET2
|
|---|
| 25 | . K ^TMP($J,"IBDRUG")
|
|---|
| 26 | . Q
|
|---|
| 27 | ;
|
|---|
| 28 | PD ;add prosthetic items
|
|---|
| 29 | D SET^IBCSC5B(IBIFN,.IBARRAY) G:'$P(IBARRAY,U,2) END
|
|---|
| 30 | S IBX=+$P(IBARRAY,U,2)+2 D SPACE
|
|---|
| 31 | S IBZ="" D SET2
|
|---|
| 32 | S IBZ="PROSTHETIC ITEMS:" D SET2
|
|---|
| 33 | S IBX=0 F S IBX=$O(IBARRAY(IBX)) Q:IBX="" S IBY=0 F S IBY=$O(IBARRAY(IBX,IBY)) Q:'IBY D
|
|---|
| 34 | . S IBZ=$$FMTE^XLFDT(IBX,2)_" "_$J($S($P(IBARRAY(IBX,IBY),U,2):"$"_$FN($P(IBARRAY(IBX,IBY),U,2),",",2),1:""),10)_" "_$E($$PINB^IBCSC5B(+IBARRAY(IBX,IBY)),1,54) D SET2
|
|---|
| 35 | ;
|
|---|
| 36 | END Q
|
|---|
| 37 | ;
|
|---|
| 38 | SET2 D SET2^IBCF33 Q
|
|---|
| 39 | SPACE D SPACE^IBCF33 Q
|
|---|
