Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEF51

IBCEF51.m

Go to the documentation of this file. 
  1. IBCEF51 ;ALB/TMP - MRA/EDI ACTIVATED UTILITIES CONTINUED ;06-FEB-96
  1.  ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
  1.  ;
  1. BTYP(IBX,IBOK,IBASK) ; Select bill types to include/exclude
  1.  ; IBX(364.41,y,x) = passed by reference.  Array containing bill type
  1.  ;          restrictions data subscripted by x=field # in file 364.41
  1.  ;          and y = sequential #
  1.  ; IBOK is passed by reference and is returned as 1 if action is
  1.  ;       successful, 0 if not
  1.  ; IBASK = flag =1 to ask for all 3 fields (edit bill type)
  1.  ;              =0 to ask for only bill type field (add rule)
  1.  ;
  1.  N IBABORT,IBCT,IBOUT,IBEXC,IBZ,DUOUT,DTOUT,Y,X,IBY,DA
  1.  S (IBOUT,IBEXC,IBOK,IBABORT)=0
  1.  S IBCT=$O(IBX(364.41,""),-1)
  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))=""
  1.  F  Q:IBOUT  F IBZ=.01,.02,.03 I $S($G(IBASK):1,1:IBZ=.01) D  Q:IBOUT
  1.  . I IBZ=.01 D  Q:IBOUT
  1.  .. S DIR("A")=$S(IBCT:"NEXT ",1:"")_"BILL TYPE"_$S('IBEXC:"",1:" TO EXCLUDE")_": " W !
  1.  . S DIR(0)="364.41,"_IBZ_$S(IBZ=.01:"AO"_$S('IBEXC:"",1:"^^I $E(Y)=""-"""),1:"O")
  1.  . I $D(IBX),IBZ=.01 D
  1.  .. N Z,CT
  1.  .. S DIR("?",1)="Enter the bill types to include/exclude.  To include, enter the"
  1.  .. S DIR("?",2)="3 digit bill type.  To exclude, precede the 3 digit bill type with a minus (-)"
  1.  .. S DIR("?",3)="You may use 'X' as a wild card.  Use XXX to include all bill types."
  1.  .. S DIR("?",4)="If XXX is entered, the rest of the entries must be bill type exclusions."
  1.  .. S CT=4
  1.  .. I $O(IBX(364.41,""))'="" S DIR("?",5)="The current bill types entered for this rule are:" D
  1.  ... S Z="",CT=5 F  S Z=$O(IBY(Z)) Q:Z=""  S CT=CT+1,DIR("?",CT)=$J("",5)_Z
  1.  .. S DIR("?")=DIR("?",CT) K DIR("?",CT)
  1.  . ;
  1.  . D ^DIR K DIR
  1.  . ;
  1.  . I $D(DUOUT)!$D(DTOUT)!(Y="") D  Q
  1.  .. I Y'="" S Y="",IBOK=0,IBABORT=1 K IBX(364.41) ; Time out or '^'
  1.  .. S:$S(IBZ'=.01:0,1:Y="") IBOUT=1
  1.  . ;
  1.  . I IBZ'=.01 S IBX(364.41,IBCT,IBZ)=Y Q
  1.  . ;
  1.  . Q:Y=""
  1.  . I '$$BTOK(Y,.IBY,0) Q
  1.  . ;
  1.  . S IBCT=IBCT+1,IBY(Y)=""
  1.  . S IBX(364.41,IBCT,.01)=Y
  1.  . ;
  1.  . I Y="XXX" D  S IBEXC=1
  1.  .. N IB
  1.  .. 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)
  1.  .. S IB="" F  S IB=$O(IBY(IB),-1) Q:IB=""!($E(IB)="-")  I IB'="XXX" K IBY(IB)
  1.  .. S IBX(364.41,IBCT,.01)="XXX"
  1.  .. W !,"  ALL BILL TYPES INCLUDED - ONLY EXCLUSIONS ALLOWED NOW",!
  1.  I 'IBABORT,'$G(IBCT) W !,"Warning ... this rule will not work unless you enter at least one bill type",! S IBOK=1
  1.  I IBABORT W !,"Timed out or '^' entered ... bill types not added",!
  1.  Q
  1.  ;
  1. INSCO(IB,IBOK,IBDA1) ; Select insurance co option and, if 
  1.  ; appropriate, the individual companies to include/exclude for the rule
  1.  ; IB = passed by reference
  1.  ;      (.07) = Returned as the internal value selected for insurance co
  1.  ;              option
  1.  ;      (364.4*,x) = Array is returned containing ins co data subscripted
  1.  ;                   by x=field # in appropriate subfile
  1.  ; IBOK is passed by reference and is returned as 1 if action is
  1.  ;       successful, 0 if not
  1.  ; IBDA1 = the ien of the rule being changed
  1.  ;
  1.  N IBCT,IBT,DIR,X,Y
  1.  S IBOK=1,IBCT=0
  1.  F  D  Q:'IBOK!(IBCT)
  1.  . N DA
  1.  . S Y=+$G(IB(.07)),DA=IBDA1
  1.  . S DIR(0)="364.4,.07A",DIR("A")="INSURANCE CO OPTION: "
  1.  . I '$G(IB(.07)) D ^DIR K DIR,DA
  1.  . I Y'>0 S IBOK=0 Q  ; Required
  1.  . S IB(.07)=+Y,IBCT=0
  1.  . I IB(.07)=3 S IBCT=999 Q
  1.  . S IBT=$S(IB(.07)=1:364.43,1:364.42)
  1.  . ;Loop until all have been entered and null entry has been detected
  1.  . 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
  1.  .. S IB(IBT,+Y)="",IBCT=IBCT+1
  1.  . I $D(DUOUT) W !,*7,"Entries deleted!",! K IB(IBT) S IBCT=0 Q
  1.  . I 'IBCT W !,*7,"Warning ... no insurance companies entered",! S IBCT=1
  1. INSQ Q
  1.  ;
  1. BTOK(Y,IBY,SUP) ; Check that bill type is valid for rule
  1.  ; Function returns 1 if OK, 0 if not
  1.  ;
  1.  ; Y = bill type being 'added' to subfile for bill type restrictions
  1.  ; IBY = array subscripted by bill types on file for rule
  1.  ; SUP = 0 if do not suppress messages
  1.  ;     = 1 suppress messages
  1.  ;
  1.  S IBOK=1
  1.  I $S($D(IBY("XXX")):0,1:$E(Y)="-") D  ; For exclude, must have included some of bill type first
  1.  . 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
  1.  . 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
  1.  ;
  1.  I 'IBOK G BTOKQ
  1.  ;
  1.  I $D(IBY("XXX")),$E(Y)'="-" D:'$G(SUP) INVAL(Y,2) S IBOK=0 G BTOKQ ; Can't include others with 'ALL'
  1.  I $D(IBY(Y)) D:'$G(SUP) INVAL(Y,3) S IBOK=0 G BTOKQ ;Bill type dup
  1.  ;
  1.  I $D(IBY("-"_Y)) D:'$G(SUP) INVAL(Y,4) S IBOK=0 ; Include/exclude for same bill type
  1.  ;
  1. BTOKQ Q IBOK
  1.  ;
  1. INVAL(Y,MES) ; Print invalid message
  1.  ; Y = the bill type in error
  1.  ; MES = the message # to print
  1.  W !,"Cannot add this bill type restrictions because:"
  1.  W !,?4
  1.  I MES=1 W "In order to exclude, you must include at least one bill type including the",!,?6," excluded bill type first"
  1.  I MES=2 W "You already have 'XXX' (all bill types) - can only EXCLUDE bill types now"
  1.  I MES=3 W "You have already entered this bill type"
  1.  I MES=4 W "You have included and excluded the same bill type"
  1.  W !
  1.  Q
  1.  ;