source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF51.m@ 812

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1IBCEF51 ;ALB/TMP - MRA/EDI ACTIVATED UTILITIES CONTINUED ;06-FEB-96
2 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
3 ;
4BTYP(IBX,IBOK,IBASK) ; Select bill types to include/exclude
5 ; IBX(364.41,y,x) = passed by reference. Array containing bill type
6 ; restrictions data subscripted by x=field # in file 364.41
7 ; and y = sequential #
8 ; IBOK is passed by reference and is returned as 1 if action is
9 ; successful, 0 if not
10 ; IBASK = flag =1 to ask for all 3 fields (edit bill type)
11 ; =0 to ask for only bill type field (add rule)
12 ;
13 N IBABORT,IBCT,IBOUT,IBEXC,IBZ,DUOUT,DTOUT,Y,X,IBY,DA
14 S (IBOUT,IBEXC,IBOK,IBABORT)=0
15 S IBCT=$O(IBX(364.41,""),-1)
16 S Z=0 F S Z=$O(IBX(364.41,Z)) Q:'Z I $D(IBX(364.41,Z,.01)) S IBY(IBX(364.41,Z,.01))=""
17 F Q:IBOUT F IBZ=.01,.02,.03 I $S($G(IBASK):1,1:IBZ=.01) D Q:IBOUT
18 . I IBZ=.01 D Q:IBOUT
19 .. S DIR("A")=$S(IBCT:"NEXT ",1:"")_"BILL TYPE"_$S('IBEXC:"",1:" TO EXCLUDE")_": " W !
20 . S DIR(0)="364.41,"_IBZ_$S(IBZ=.01:"AO"_$S('IBEXC:"",1:"^^I $E(Y)=""-"""),1:"O")
21 . I $D(IBX),IBZ=.01 D
22 .. N Z,CT
23 .. S DIR("?",1)="Enter the bill types to include/exclude. To include, enter the"
24 .. S DIR("?",2)="3 digit bill type. To exclude, precede the 3 digit bill type with a minus (-)"
25 .. S DIR("?",3)="You may use 'X' as a wild card. Use XXX to include all bill types."
26 .. S DIR("?",4)="If XXX is entered, the rest of the entries must be bill type exclusions."
27 .. S CT=4
28 .. I $O(IBX(364.41,""))'="" S DIR("?",5)="The current bill types entered for this rule are:" D
29 ... S Z="",CT=5 F S Z=$O(IBY(Z)) Q:Z="" S CT=CT+1,DIR("?",CT)=$J("",5)_Z
30 .. S DIR("?")=DIR("?",CT) K DIR("?",CT)
31 . ;
32 . D ^DIR K DIR
33 . ;
34 . I $D(DUOUT)!$D(DTOUT)!(Y="") D Q
35 .. I Y'="" S Y="",IBOK=0,IBABORT=1 K IBX(364.41) ; Time out or '^'
36 .. S:$S(IBZ'=.01:0,1:Y="") IBOUT=1
37 . ;
38 . I IBZ'=.01 S IBX(364.41,IBCT,IBZ)=Y Q
39 . ;
40 . Q:Y=""
41 . I '$$BTOK(Y,.IBY,0) Q
42 . ;
43 . S IBCT=IBCT+1,IBY(Y)=""
44 . S IBX(364.41,IBCT,.01)=Y
45 . ;
46 . I Y="XXX" D S IBEXC=1
47 .. N IB
48 .. S IB=0 F S IB=$O(IBX(364.41,IB)) Q:'IB I $E($G(IBX(364.41,IB,.01)))'="-" K IBX(364.41,IB)
49 .. S IB="" F S IB=$O(IBY(IB),-1) Q:IB=""!($E(IB)="-") I IB'="XXX" K IBY(IB)
50 .. S IBX(364.41,IBCT,.01)="XXX"
51 .. W !," ALL BILL TYPES INCLUDED - ONLY EXCLUSIONS ALLOWED NOW",!
52 I 'IBABORT,'$G(IBCT) W !,"Warning ... this rule will not work unless you enter at least one bill type",! S IBOK=1
53 I IBABORT W !,"Timed out or '^' entered ... bill types not added",!
54 Q
55 ;
56INSCO(IB,IBOK,IBDA1) ; Select insurance co option and, if
57 ; appropriate, the individual companies to include/exclude for the rule
58 ; IB = passed by reference
59 ; (.07) = Returned as the internal value selected for insurance co
60 ; option
61 ; (364.4*,x) = Array is returned containing ins co data subscripted
62 ; by x=field # in appropriate subfile
63 ; IBOK is passed by reference and is returned as 1 if action is
64 ; successful, 0 if not
65 ; IBDA1 = the ien of the rule being changed
66 ;
67 N IBCT,IBT,DIR,X,Y
68 S IBOK=1,IBCT=0
69 F D Q:'IBOK!(IBCT)
70 . N DA
71 . S Y=+$G(IB(.07)),DA=IBDA1
72 . S DIR(0)="364.4,.07A",DIR("A")="INSURANCE CO OPTION: "
73 . I '$G(IB(.07)) D ^DIR K DIR,DA
74 . I Y'>0 S IBOK=0 Q ; Required
75 . S IB(.07)=+Y,IBCT=0
76 . I IB(.07)=3 S IBCT=999 Q
77 . S IBT=$S(IB(.07)=1:364.43,1:364.42)
78 . ;Loop until all have been entered and null entry has been detected
79 . F S DIR(0)=IBT_",.01AO",DIR("A")="Select Insurance Co to "_$S(IBT["43":"in",1:"ex")_"clude for this rule: " D ^DIR K DIR Q:Y'>0 D
80 .. S IB(IBT,+Y)="",IBCT=IBCT+1
81 . I $D(DUOUT) W !,*7,"Entries deleted!",! K IB(IBT) S IBCT=0 Q
82 . I 'IBCT W !,*7,"Warning ... no insurance companies entered",! S IBCT=1
83INSQ Q
84 ;
85BTOK(Y,IBY,SUP) ; Check that bill type is valid for rule
86 ; Function returns 1 if OK, 0 if not
87 ;
88 ; Y = bill type being 'added' to subfile for bill type restrictions
89 ; IBY = array subscripted by bill types on file for rule
90 ; SUP = 0 if do not suppress messages
91 ; = 1 suppress messages
92 ;
93 S IBOK=1
94 I $S($D(IBY("XXX")):0,1:$E(Y)="-") D ; For exclude, must have included some of bill type first
95 . I Y?1"-"3N S Z=$E(Y,2)_"XX",Z0=$E(Y,2,3)_"X" Q:$D(IBY(Z))!$D(IBY(Z0)) D:'$G(SUP) INVAL(Y,1) S IBOK=0 Q
96 . I Y?1"-"2N1"X" S Z=$E(Y,2)_"XX" Q:$D(IBY(Z)) D:'$G(SUP) INVAL(Y,1) S IBOK=0 Q
97 ;
98 I 'IBOK G BTOKQ
99 ;
100 I $D(IBY("XXX")),$E(Y)'="-" D:'$G(SUP) INVAL(Y,2) S IBOK=0 G BTOKQ ; Can't include others with 'ALL'
101 I $D(IBY(Y)) D:'$G(SUP) INVAL(Y,3) S IBOK=0 G BTOKQ ;Bill type dup
102 ;
103 I $D(IBY("-"_Y)) D:'$G(SUP) INVAL(Y,4) S IBOK=0 ; Include/exclude for same bill type
104 ;
105BTOKQ Q IBOK
106 ;
107INVAL(Y,MES) ; Print invalid message
108 ; Y = the bill type in error
109 ; MES = the message # to print
110 W !,"Cannot add this bill type restrictions because:"
111 W !,?4
112 I MES=1 W "In order to exclude, you must include at least one bill type including the",!,?6," excluded bill type first"
113 I MES=2 W "You already have 'XXX' (all bill types) - can only EXCLUDE bill types now"
114 I MES=3 W "You have already entered this bill type"
115 I MES=4 W "You have included and excluded the same bill type"
116 W !
117 Q
118 ;
Note: See TracBrowser for help on using the repository browser.