source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRLL.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1IBCRLL ;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 ;
5EN ; -- main entry point for IBCR SPECIAL GROUPS
6 D EN^VALM("IBCR SPECIAL GROUPS")
7 Q
8 ;
9HDR ; -- header code
10 S VALMHDR(1)=" "
11 Q
12 ;
13INIT ; -- init variables and list array
14 K ^TMP("IBCRLL",$J)
15 D BLD
16 Q
17 ;
18HELP ; -- help code
19 S X="?" D DISP^XQORM1 W !!
20 Q
21 ;
22EXIT ; -- exit code
23 K ^TMP("IBCRLL",$J)
24 D CLEAR^VALM1,CLEAN^VALM10
25 Q
26 ;
27BLD ; 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 ;
58SET(X) ; set up list manager screen array
59 S VALMCNT=VALMCNT+1
60 S ^TMP("IBCRLL",$J,VALMCNT,0)=X
61 Q
62 ;
63SORTSG ; 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
Note: See TracBrowser for help on using the repository browser.