| 1 | IBCRLN ;ALB/ARH - RATES: DISPLAY PROVIDER DISCOUNT ; 10-OCT-1998
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**106,148**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; -- main entry point for IBCR PROVIDER DISCOUNT
|
|---|
| 6 | D EN^VALM("IBCR PROVIDER DISCOUNT")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | S VALMHDR(1)="Provider Discounts for "_$P($G(^IBE(363.32,+$G(IBSGFN),0)),U,1)_" Group."
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- init variables and list array
|
|---|
| 14 | K ^TMP("IBCRLN",$J),^TMP("IBCRLNX1",$J)
|
|---|
| 15 | I '$G(IBSGFN) S IBSGFN=$$GETSG^IBCRU1(2) I IBSGFN'>0 S VALMQUIT="" Q
|
|---|
| 16 | D BLD
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | HELP ; -- help code
|
|---|
| 20 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | EXIT ; -- exit code
|
|---|
| 24 | K ^TMP("IBCRLN",$J),^TMP("IBCRLNX1",$J)
|
|---|
| 25 | D CLEAR^VALM1,CLEAN^VALM10
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | BLD ; build charge set display array
|
|---|
| 29 | N IBPDN,IBPDFN,IBPD0,IBPCVA,IBPCFN,IBPC,IBX,IBY,IBZ S VALMCNT=0 K ^TMP($J,"IBCRLN")
|
|---|
| 30 | ;
|
|---|
| 31 | D SORT
|
|---|
| 32 | ;
|
|---|
| 33 | ; create LM display array
|
|---|
| 34 | S IBPDN="" F S IBPDN=$O(^TMP($J,"IBCRLN",IBPDN)) Q:IBPDN="" D
|
|---|
| 35 | . ;
|
|---|
| 36 | . S IBPDFN=+$G(^TMP($J,"IBCRLN",IBPDN)),IBPD0=$G(^IBE(363.34,+IBPDFN,0)) I $P(IBPD0,U,2)'=+$G(IBSGFN) Q
|
|---|
| 37 | . ;
|
|---|
| 38 | . D SET("",IBPDFN) S IBY=" Provider Type: "_$P(IBPD0,U,1)
|
|---|
| 39 | . D SET(IBY) D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM) D SET("")
|
|---|
| 40 | . ;
|
|---|
| 41 | . S IBY=""
|
|---|
| 42 | . S IBZ=$P(IBPD0,U,3) I IBZ'="" S IBX=$J(IBZ,3)_"%",IBY=$$SETFLD^VALM1(IBX,IBY,"PCNT")
|
|---|
| 43 | . ;
|
|---|
| 44 | . I '$O(^IBE(363.34,+IBPDFN,11,0)) S IBX="No Person Class Assigned",IBY=$$SETFLD^VALM1(IBX,IBY,"PRVPC") D SET(IBY) S IBY=""
|
|---|
| 45 | . ;
|
|---|
| 46 | . S IBPCVA="" F S IBPCVA=$O(^TMP($J,"IBCRLN",IBPDN,IBPCVA)) Q:IBPCVA="" D
|
|---|
| 47 | .. ;
|
|---|
| 48 | .. S IBPCFN=+$G(^TMP($J,"IBCRLN",IBPDN,IBPCVA)) Q:'IBPCFN
|
|---|
| 49 | .. S IBPC=$$CODE2TXT^XUA4A72(+IBPCFN)
|
|---|
| 50 | .. I $P(IBPC,U,1)'="" S IBX=IBPCVA_" "_$P(IBPC,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"PRVPC") D SET(IBY) S IBY=""
|
|---|
| 51 | .. I $P(IBPC,U,2)'="" S IBX=" "_$P(IBPC,U,2),IBY=$$SETFLD^VALM1(IBX,IBY,"PRVPC") D SET(IBY) S IBY=""
|
|---|
| 52 | .. I $P(IBPC,U,3)'="" S IBX=" "_$P(IBPC,U,3),IBY=$$SETFLD^VALM1(IBX,IBY,"PRVPC") D SET(IBY) S IBY=""
|
|---|
| 53 | . I IBY'="" D SET(IBY) S IBY=""
|
|---|
| 54 | ;
|
|---|
| 55 | I VALMCNT=0 D SET(" "),SET("No Provider Discounts for this Group")
|
|---|
| 56 | ;
|
|---|
| 57 | K ^TMP($J,"IBCRLN")
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | ;
|
|---|
| 61 | SET(X,PDFN) ; set up list manager screen array
|
|---|
| 62 | S VALMCNT=VALMCNT+1
|
|---|
| 63 | S ^TMP("IBCRLN",$J,VALMCNT,0)=X
|
|---|
| 64 | I +$G(PDFN) S ^TMP("IBCRLNX1",$J,+PDFN)=VALMCNT
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | SORT ; sort the provider discount group by Provider Type then VA Code (IBSGFN expected)
|
|---|
| 68 | N IBPDFN,IBPD0,IBPDN,IBPCFN,IBPCVA
|
|---|
| 69 | S IBPDFN=0 F S IBPDFN=$O(^IBE(363.34,IBPDFN)) Q:'IBPDFN D
|
|---|
| 70 | . S IBPD0=$G(^IBE(363.34,IBPDFN,0)),IBPDN=$P(IBPD0,U,1)_" " I $P(IBPD0,U,2)'=+$G(IBSGFN) Q
|
|---|
| 71 | . S ^TMP($J,"IBCRLN",IBPDN)=IBPDFN
|
|---|
| 72 | . S IBPCFN=0 F S IBPCFN=$O(^IBE(363.34,IBPDFN,11,"B",IBPCFN)) Q:'IBPCFN D
|
|---|
| 73 | .. S IBPCVA=$$IEN2CODE^XUA4A72(IBPCFN)_" "
|
|---|
| 74 | .. S ^TMP($J,"IBCRLN",IBPDN,IBPCVA)=IBPCFN
|
|---|
| 75 | Q
|
|---|
