| 1 | IBCRLL ;ALB/ARH - RATES: DISPLAY SPECIAL GROUPS ; 10-OCT-1998
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**106**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; -- main entry point for IBCR SPECIAL GROUPS
|
|---|
| 6 | D EN^VALM("IBCR SPECIAL GROUPS")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | S VALMHDR(1)=" "
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- init variables and list array
|
|---|
| 14 | K ^TMP("IBCRLL",$J)
|
|---|
| 15 | D BLD
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | HELP ; -- help code
|
|---|
| 19 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | EXIT ; -- exit code
|
|---|
| 23 | K ^TMP("IBCRLL",$J)
|
|---|
| 24 | D CLEAR^VALM1,CLEAN^VALM10
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | BLD ; build charge set display array
|
|---|
| 28 | N IBTYNM,IBSGNM,IBSGFN,IBSGFN1,IBSG10,IBX,IBY S VALMCNT=0 K ^TMP($J,"IBCRXL")
|
|---|
| 29 | ;
|
|---|
| 30 | D SORTSG
|
|---|
| 31 | ;
|
|---|
| 32 | ; create LM display array
|
|---|
| 33 | S IBTYNM="" F S IBTYNM=$O(^TMP($J,"IBCRXL",IBTYNM)) Q:IBTYNM="" D
|
|---|
| 34 | . ;
|
|---|
| 35 | . D SET("") S IBY=" Group Type: "_IBTYNM
|
|---|
| 36 | . D SET(IBY) D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM) D SET("")
|
|---|
| 37 | . ;
|
|---|
| 38 | . S IBSGNM="" F S IBSGNM=$O(^TMP($J,"IBCRXL",IBTYNM,IBSGNM)) Q:IBSGNM="" D
|
|---|
| 39 | .. ;
|
|---|
| 40 | .. S IBY="",IBX=IBSGNM,IBY=$$SETFLD^VALM1(IBX,IBY,"GRP")
|
|---|
| 41 | .. ;
|
|---|
| 42 | .. S IBSGFN=$G(^TMP($J,"IBCRXL",IBTYNM,IBSGNM)) Q:'IBSGFN
|
|---|
| 43 | .. S IBSGFN1=0 F S IBSGFN1=$O(^IBE(363.32,IBSGFN,11,IBSGFN1)) Q:'IBSGFN1 D
|
|---|
| 44 | ... ;
|
|---|
| 45 | ... S IBSG10=$G(^IBE(363.32,IBSGFN,11,IBSGFN1,0)) Q:'IBSG10
|
|---|
| 46 | ... S IBX=$P($G(^IBE(363.3,+IBSG10,0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"BR")
|
|---|
| 47 | ... I +$P(IBSG10,U,2) S IBX=$P($G(^IBE(363.1,+$P(IBSG10,U,2),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"CS")
|
|---|
| 48 | ... S IBX=$P(IBSG10,U,3),IBY=$$SETFLD^VALM1(IBX,IBY,"ORD")
|
|---|
| 49 | ... D SET(IBY) S IBY=""
|
|---|
| 50 | .. I IBY'="" D SET(IBY) S IBY=""
|
|---|
| 51 | ;
|
|---|
| 52 | I VALMCNT=0 D SET(" "),SET("No Special Groups")
|
|---|
| 53 | ;
|
|---|
| 54 | K ^TMP($J,"IBCRXL")
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;
|
|---|
| 58 | SET(X) ; set up list manager screen array
|
|---|
| 59 | S VALMCNT=VALMCNT+1
|
|---|
| 60 | S ^TMP("IBCRLL",$J,VALMCNT,0)=X
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | SORTSG ; created array of all Special Link Groups sorted by Type and Name
|
|---|
| 64 | ; ^TMP($J,"IBCRXL", group type name) = group type set value
|
|---|
| 65 | ; ^TMP($J,"IBCRXL", group type name, group name) = group name IFN
|
|---|
| 66 | N IBSGFN,IBSGNM,IBTYNM,IBLN
|
|---|
| 67 | S IBSGFN=0 F S IBSGFN=$O(^IBE(363.32,IBSGFN)) Q:'IBSGFN D
|
|---|
| 68 | . S IBLN=$G(^IBE(363.32,IBSGFN,0))
|
|---|
| 69 | . S IBSGNM=$P(IBLN,U,1) I IBSGNM="" S IBSGNM=" "
|
|---|
| 70 | . S IBTYNM=$$EXPAND^IBCRU1(363.32,.02,$P(IBLN,U,2)) I IBTYNM="" S IBTYNM=" "
|
|---|
| 71 | . S ^TMP($J,"IBCRXL",IBTYNM)=$P(IBLN,U,2)
|
|---|
| 72 | . S ^TMP($J,"IBCRXL",IBTYNM,IBSGNM)=IBSGFN
|
|---|
| 73 | Q
|
|---|
