IBCEF51 ;ALB/TMP - MRA/EDI ACTIVATED UTILITIES CONTINUED ;06-FEB-96
;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
;
BTYP(IBX,IBOK,IBASK) ; Select bill types to include/exclude
; IBX(364.41,y,x) = passed by reference. Array containing bill type
; restrictions data subscripted by x=field # in file 364.41
; and y = sequential #
; IBOK is passed by reference and is returned as 1 if action is
; successful, 0 if not
; IBASK = flag =1 to ask for all 3 fields (edit bill type)
; =0 to ask for only bill type field (add rule)
;
N IBABORT,IBCT,IBOUT,IBEXC,IBZ,DUOUT,DTOUT,Y,X,IBY,DA
S (IBOUT,IBEXC,IBOK,IBABORT)=0
S IBCT=$O(IBX(364.41,""),-1)
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))=""
F Q:IBOUT F IBZ=.01,.02,.03 I $S($G(IBASK):1,1:IBZ=.01) D Q:IBOUT
. I IBZ=.01 D Q:IBOUT
.. S DIR("A")=$S(IBCT:"NEXT ",1:"")_"BILL TYPE"_$S('IBEXC:"",1:" TO EXCLUDE")_": " W !
. S DIR(0)="364.41,"_IBZ_$S(IBZ=.01:"AO"_$S('IBEXC:"",1:"^^I $E(Y)=""-"""),1:"O")
. I $D(IBX),IBZ=.01 D
.. N Z,CT
.. S DIR("?",1)="Enter the bill types to include/exclude. To include, enter the"
.. S DIR("?",2)="3 digit bill type. To exclude, precede the 3 digit bill type with a minus (-)"
.. S DIR("?",3)="You may use 'X' as a wild card. Use XXX to include all bill types."
.. S DIR("?",4)="If XXX is entered, the rest of the entries must be bill type exclusions."
.. S CT=4
.. I $O(IBX(364.41,""))'="" S DIR("?",5)="The current bill types entered for this rule are:" D
... S Z="",CT=5 F S Z=$O(IBY(Z)) Q:Z="" S CT=CT+1,DIR("?",CT)=$J("",5)_Z
.. S DIR("?")=DIR("?",CT) K DIR("?",CT)
. ;
. D ^DIR K DIR
. ;
. I $D(DUOUT)!$D(DTOUT)!(Y="") D Q
.. I Y'="" S Y="",IBOK=0,IBABORT=1 K IBX(364.41) ; Time out or '^'
.. S:$S(IBZ'=.01:0,1:Y="") IBOUT=1
. ;
. I IBZ'=.01 S IBX(364.41,IBCT,IBZ)=Y Q
. ;
. Q:Y=""
. I '$$BTOK(Y,.IBY,0) Q
. ;
. S IBCT=IBCT+1,IBY(Y)=""
. S IBX(364.41,IBCT,.01)=Y
. ;
. I Y="XXX" D S IBEXC=1
.. N IB
.. 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)
.. S IB="" F S IB=$O(IBY(IB),-1) Q:IB=""!($E(IB)="-") I IB'="XXX" K IBY(IB)
.. S IBX(364.41,IBCT,.01)="XXX"
.. W !," ALL BILL TYPES INCLUDED - ONLY EXCLUSIONS ALLOWED NOW",!
I 'IBABORT,'$G(IBCT) W !,"Warning ... this rule will not work unless you enter at least one bill type",! S IBOK=1
I IBABORT W !,"Timed out or '^' entered ... bill types not added",!
Q
;
INSCO(IB,IBOK,IBDA1) ; Select insurance co option and, if
; appropriate, the individual companies to include/exclude for the rule
; IB = passed by reference
; (.07) = Returned as the internal value selected for insurance co
; option
; (364.4*,x) = Array is returned containing ins co data subscripted
; by x=field # in appropriate subfile
; IBOK is passed by reference and is returned as 1 if action is
; successful, 0 if not
; IBDA1 = the ien of the rule being changed
;
N IBCT,IBT,DIR,X,Y
S IBOK=1,IBCT=0
F D Q:'IBOK!(IBCT)
. N DA
. S Y=+$G(IB(.07)),DA=IBDA1
. S DIR(0)="364.4,.07A",DIR("A")="INSURANCE CO OPTION: "
. I '$G(IB(.07)) D ^DIR K DIR,DA
. I Y'>0 S IBOK=0 Q ; Required
. S IB(.07)=+Y,IBCT=0
. I IB(.07)=3 S IBCT=999 Q
. S IBT=$S(IB(.07)=1:364.43,1:364.42)
. ;Loop until all have been entered and null entry has been detected
. 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
.. S IB(IBT,+Y)="",IBCT=IBCT+1
. I $D(DUOUT) W !,*7,"Entries deleted!",! K IB(IBT) S IBCT=0 Q
. I 'IBCT W !,*7,"Warning ... no insurance companies entered",! S IBCT=1
INSQ Q
;
BTOK(Y,IBY,SUP) ; Check that bill type is valid for rule
; Function returns 1 if OK, 0 if not
;
; Y = bill type being 'added' to subfile for bill type restrictions
; IBY = array subscripted by bill types on file for rule
; SUP = 0 if do not suppress messages
; = 1 suppress messages
;
S IBOK=1
I $S($D(IBY("XXX")):0,1:$E(Y)="-") D ; For exclude, must have included some of bill type first
. 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
. 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
;
I 'IBOK G BTOKQ
;
I $D(IBY("XXX")),$E(Y)'="-" D:'$G(SUP) INVAL(Y,2) S IBOK=0 G BTOKQ ; Can't include others with 'ALL'
I $D(IBY(Y)) D:'$G(SUP) INVAL(Y,3) S IBOK=0 G BTOKQ ;Bill type dup
;
I $D(IBY("-"_Y)) D:'$G(SUP) INVAL(Y,4) S IBOK=0 ; Include/exclude for same bill type
;
BTOKQ Q IBOK
;
INVAL(Y,MES) ; Print invalid message
; Y = the bill type in error
; MES = the message # to print
W !,"Cannot add this bill type restrictions because:"
W !,?4
I MES=1 W "In order to exclude, you must include at least one bill type including the",!,?6," excluded bill type first"
I MES=2 W "You already have 'XXX' (all bill types) - can only EXCLUDE bill types now"
I MES=3 W "You have already entered this bill type"
I MES=4 W "You have included and excluded the same bill type"
W !
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF51 5211 printed Nov 22, 2024@17:20:12 Page 2
IBCEF51 ;ALB/TMP - MRA/EDI ACTIVATED UTILITIES CONTINUED ;06-FEB-96
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
+2 ;
BTYP(IBX,IBOK,IBASK) ; Select bill types to include/exclude
+1 ; IBX(364.41,y,x) = passed by reference. Array containing bill type
+2 ; restrictions data subscripted by x=field # in file 364.41
+3 ; and y = sequential #
+4 ; IBOK is passed by reference and is returned as 1 if action is
+5 ; successful, 0 if not
+6 ; IBASK = flag =1 to ask for all 3 fields (edit bill type)
+7 ; =0 to ask for only bill type field (add rule)
+8 ;
+9 NEW IBABORT,IBCT,IBOUT,IBEXC,IBZ,DUOUT,DTOUT,Y,X,IBY,DA
+10 SET (IBOUT,IBEXC,IBOK,IBABORT)=0
+11 SET IBCT=$ORDER(IBX(364.41,""),-1)
+12 SET Z=0
FOR
SET Z=$ORDER(IBX(364.41,Z))
if 'Z
QUIT
IF $DATA(IBX(364.41,Z,.01))
SET IBY(IBX(364.41,Z,.01))=""
+13 FOR
if IBOUT
QUIT
FOR IBZ=.01,.02,.03
IF $SELECT($GET(IBASK):1,1:IBZ=.01)
Begin DoDot:1
+14 IF IBZ=.01
Begin DoDot:2
+15 SET DIR("A")=$SELECT(IBCT:"NEXT ",1:"")_"BILL TYPE"_$SELECT('IBEXC:"",1:" TO EXCLUDE")_": "
WRITE !
End DoDot:2
if IBOUT
QUIT
+16 SET DIR(0)="364.41,"_IBZ_$SELECT(IBZ=.01:"AO"_$SELECT('IBEXC:"",1:"^^I $E(Y)=""-"""),1:"O")
+17 IF $DATA(IBX)
IF IBZ=.01
Begin DoDot:2
+18 NEW Z,CT
+19 SET DIR("?",1)="Enter the bill types to include/exclude. To include, enter the"
+20 SET DIR("?",2)="3 digit bill type. To exclude, precede the 3 digit bill type with a minus (-)"
+21 SET DIR("?",3)="You may use 'X' as a wild card. Use XXX to include all bill types."
+22 SET DIR("?",4)="If XXX is entered, the rest of the entries must be bill type exclusions."
+23 SET CT=4
+24 IF $ORDER(IBX(364.41,""))'=""
SET DIR("?",5)="The current bill types entered for this rule are:"
Begin DoDot:3
+25 SET Z=""
SET CT=5
FOR
SET Z=$ORDER(IBY(Z))
if Z=""
QUIT
SET CT=CT+1
SET DIR("?",CT)=$JUSTIFY("",5)_Z
End DoDot:3
+26 SET DIR("?")=DIR("?",CT)
KILL DIR("?",CT)
End DoDot:2
+27 ;
+28 DO ^DIR
KILL DIR
+29 ;
+30 IF $DATA(DUOUT)!$DATA(DTOUT)!(Y="")
Begin DoDot:2
+31 ; Time out or '^'
IF Y'=""
SET Y=""
SET IBOK=0
SET IBABORT=1
KILL IBX(364.41)
+32 if $SELECT(IBZ'=.01
SET IBOUT=1
End DoDot:2
QUIT
+33 ;
+34 IF IBZ'=.01
SET IBX(364.41,IBCT,IBZ)=Y
QUIT
+35 ;
+36 if Y=""
QUIT
+37 IF '$$BTOK(Y,.IBY,0)
QUIT
+38 ;
+39 SET IBCT=IBCT+1
SET IBY(Y)=""
+40 SET IBX(364.41,IBCT,.01)=Y
+41 ;
+42 IF Y="XXX"
Begin DoDot:2
+43 NEW IB
+44 SET IB=0
FOR
SET IB=$ORDER(IBX(364.41,IB))
if 'IB
QUIT
IF $EXTRACT($GET(IBX(364.41,IB,.01)))'="-"
KILL IBX(364.41,IB)
+45 SET IB=""
FOR
SET IB=$ORDER(IBY(IB),-1)
if IB=""!($EXTRACT(IB)="-")
QUIT
IF IB'="XXX"
KILL IBY(IB)
+46 SET IBX(364.41,IBCT,.01)="XXX"
+47 WRITE !," ALL BILL TYPES INCLUDED - ONLY EXCLUSIONS ALLOWED NOW",!
End DoDot:2
SET IBEXC=1
End DoDot:1
if IBOUT
QUIT
+48 IF 'IBABORT
IF '$GET(IBCT)
WRITE !,"Warning ... this rule will not work unless you enter at least one bill type",!
SET IBOK=1
+49 IF IBABORT
WRITE !,"Timed out or '^' entered ... bill types not added",!
+50 QUIT
+51 ;
INSCO(IB,IBOK,IBDA1) ; Select insurance co option and, if
+1 ; appropriate, the individual companies to include/exclude for the rule
+2 ; IB = passed by reference
+3 ; (.07) = Returned as the internal value selected for insurance co
+4 ; option
+5 ; (364.4*,x) = Array is returned containing ins co data subscripted
+6 ; by x=field # in appropriate subfile
+7 ; IBOK is passed by reference and is returned as 1 if action is
+8 ; successful, 0 if not
+9 ; IBDA1 = the ien of the rule being changed
+10 ;
+11 NEW IBCT,IBT,DIR,X,Y
+12 SET IBOK=1
SET IBCT=0
+13 FOR
Begin DoDot:1
+14 NEW DA
+15 SET Y=+$GET(IB(.07))
SET DA=IBDA1
+16 SET DIR(0)="364.4,.07A"
SET DIR("A")="INSURANCE CO OPTION: "
+17 IF '$GET(IB(.07))
DO ^DIR
KILL DIR,DA
+18 ; Required
IF Y'>0
SET IBOK=0
QUIT
+19 SET IB(.07)=+Y
SET IBCT=0
+20 IF IB(.07)=3
SET IBCT=999
QUIT
+21 SET IBT=$SELECT(IB(.07)=1:364.43,1:364.42)
+22 ;Loop until all have been entered and null entry has been detected
+23 FOR
SET DIR(0)=IBT_",.01AO"
SET DIR("A")="Select Insurance Co to "_$SELECT(IBT["43":"in",1:"ex")_"clude for this rule: "
DO ^DIR
KILL DIR
if Y'>0
QUIT
Begin DoDot:2
+24 SET IB(IBT,+Y)=""
SET IBCT=IBCT+1
End DoDot:2
+25 IF $DATA(DUOUT)
WRITE !,*7,"Entries deleted!",!
KILL IB(IBT)
SET IBCT=0
QUIT
+26 IF 'IBCT
WRITE !,*7,"Warning ... no insurance companies entered",!
SET IBCT=1
End DoDot:1
if 'IBOK!(IBCT)
QUIT
INSQ QUIT
+1 ;
BTOK(Y,IBY,SUP) ; Check that bill type is valid for rule
+1 ; Function returns 1 if OK, 0 if not
+2 ;
+3 ; Y = bill type being 'added' to subfile for bill type restrictions
+4 ; IBY = array subscripted by bill types on file for rule
+5 ; SUP = 0 if do not suppress messages
+6 ; = 1 suppress messages
+7 ;
+8 SET IBOK=1
+9 ; For exclude, must have included some of bill type first
IF $SELECT($DATA(IBY("XXX")):0,1:$EXTRACT(Y)="-")
Begin DoDot:1
+10 IF Y?1"-"3N
SET Z=$EXTRACT(Y,2)_"XX"
SET Z0=$EXTRACT(Y,2,3)_"X"
if $DATA(IBY(Z))!$DATA(IBY(Z0))
QUIT
if '$GET(SUP)
DO INVAL(Y,1)
SET IBOK=0
QUIT
+11 IF Y?1"-"2N1"X"
SET Z=$EXTRACT(Y,2)_"XX"
if $DATA(IBY(Z))
QUIT
if '$GET(SUP)
DO INVAL(Y,1)
SET IBOK=0
QUIT
End DoDot:1
+12 ;
+13 IF 'IBOK
GOTO BTOKQ
+14 ;
+15 ; Can't include others with 'ALL'
IF $DATA(IBY("XXX"))
IF $EXTRACT(Y)'="-"
if '$GET(SUP)
DO INVAL(Y,2)
SET IBOK=0
GOTO BTOKQ
+16 ;Bill type dup
IF $DATA(IBY(Y))
if '$GET(SUP)
DO INVAL(Y,3)
SET IBOK=0
GOTO BTOKQ
+17 ;
+18 ; Include/exclude for same bill type
IF $DATA(IBY("-"_Y))
if '$GET(SUP)
DO INVAL(Y,4)
SET IBOK=0
+19 ;
BTOKQ QUIT IBOK
+1 ;
INVAL(Y,MES) ; Print invalid message
+1 ; Y = the bill type in error
+2 ; MES = the message # to print
+3 WRITE !,"Cannot add this bill type restrictions because:"
+4 WRITE !,?4
+5 IF MES=1
WRITE "In order to exclude, you must include at least one bill type including the",!,?6," excluded bill type first"
+6 IF MES=2
WRITE "You already have 'XXX' (all bill types) - can only EXCLUDE bill types now"
+7 IF MES=3
WRITE "You have already entered this bill type"
+8 IF MES=4
WRITE "You have included and excluded the same bill type"
+9 WRITE !
+10 QUIT
+11 ;
