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

IBCEF61.m

Go to the documentation of this file.
  1. IBCEF61 ;ALB/TMP - EDI TRANSMISSION RULES DEFINITION ;28-APR-99
  1. ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
  1. ;
  1. SELRULE(IBRULE) ; Select rule
  1. D FULL^VALM1
  1. S IBRULE=""
  1. N IBR,IB
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. S IBR=0 F S IBR=$O(VALMY(IBR)) Q:'IBR S IB=$G(^TMP("IBCE-RULEDX",$J,IBR)),IBRULE=+$P(IB,U,2)
  1. Q
  1. ;
  1. ACTIVE(IBRULE) ; Edit rules' active/inactive dates
  1. ; IBRULE = ien of rule in file 364.4
  1. ;
  1. G:'$G(IBRULE) ACTQ
  1. N DA,DR,DIE,X,Y,Z,Z0
  1. S DA=$G(IBRULE),DIE="^IBE(364.4,"
  1. S DR=".02;.06"
  1. D ^DIE
  1. I $D(Y) S IBRULE=0 G ACTQ
  1. D REBLD^IBCEF6($G(IBACTIVE))
  1. ACTQ S VALMBCK="R"
  1. Q
  1. ;
  1. SCRACT ; Rebld display - only currently active
  1. S IBACTIVE=1
  1. D REBLD^IBCEF6(1)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. NOSCR ; Rebld display - inactive and currently active
  1. S IBACTIVE=0
  1. D REBLD^IBCEF6(0)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. BILTYP(IBRULE) ; Allow to edit bill types for rule
  1. ; IBRULE = ien of rule - file 364.4
  1. ;
  1. G:'$G(IBRULE) BILTYPQ
  1. N DA,DR,DIE,X,Y,Z,Z0,IBRT,IB,IBOK,IBCT
  1. S DA=$G(IBRULE),DIE="^IBE(364.4,",IBRT=$P($G(^IBE(364.4,IBRULE,0)),U,11)
  1. I $S(IBRT=9:0,1:IBRT'=1) D G BILTYPQ
  1. . W !
  1. . S DIR(0)="EA",DIR("A",1)="RULE TYPE '"_$$EXPAND^IBTRE(364.4,.11,IBRT)_"' DOES NOT ALLOW BILL TYPE RESTRICTIONS",DIR("A")="PRESS RETURN " D ^DIR K DIR W !
  1. S (IBO,IBCT)=0 ;Extract existing entries
  1. F S IBO=$O(^IBE(364.4,IBRULE,"BTYP",IBO)) Q:'IBO S IBX=$P($G(^(IBO,0)),U),IBO(IBX)=IBO_U_$P(^(0),U,2,3),IBCT=IBCT+1,IB(364.41,IBCT,.01)=IBX,IBI(IBX)=IBCT F Z=2,3 I $P(IBO(IBX),U,Z)'="" S IB(364.41,IBCT,Z/100)=$P(IBO(IBX),U,Z)
  1. ; Display entries, allow to add/edit/delete
  1. D EN^IBCEF62
  1. BILTYPQ S VALMBCK="R"
  1. Q
  1. ;
  1. SEL(VALMY) ; Select one or more bill type restriction entries
  1. ; VALMY = passed by reference and returned subscripted by
  1. ; entry #(s) in the LM array selected
  1. ;
  1. N Z
  1. D FULL^VALM1
  1. N IBR
  1. D EN^VALM2($G(XQORNOD(0)))
  1. Q
  1. ;
  1. BTEDIT(IBRULE) ; Edit bill type restriction dates
  1. ; IBRULE = ien of the bill type restriction being edited
  1. ; (0)= ien of the RULE - file 364.4
  1. G:'$G(IBRULE) BTEQ
  1. ;
  1. N DA,DIE,DR,Y,X,VALMY,Z,IBBT
  1. ;
  1. S IBCT=0
  1. D SEL(.VALMY)
  1. G:'$O(VALMY(0)) BTEQ ; None selected
  1. ;
  1. S Z=0 F S Z=$O(VALMY(Z)) Q:'Z S IBBT=+$G(^TMP("IBCE-BTDX",$J,Z)) I IBBT D
  1. . S DA(1)=IBRULE,DA=IBBT,DIE="^IBE(364.4,"_DA(1)_",""BTYP"",",DR=".02;.03"
  1. . W !!,"Bill Type Restriction #"_Z_" - "_$E($G(^TMP("IBCE-BT",$J,Z,0)),5,50),!
  1. . D ^DIE
  1. . D REBLD^IBCEF62
  1. ;
  1. BTEQ S VALMBCK="R"
  1. Q
  1. ;
  1. BTADD(IBRULE) ; Add new bill type restrictions
  1. ; IBRULE = ien of rule entry - file 364.4
  1. N IB,IBCT,Z,IBOK
  1. D FULL^VALM1
  1. G:'$G(IBRULE) BTAQ
  1. ;
  1. S (IBCT,Z)=0
  1. S Z=0 F S Z=$O(^IBE(364.4,IBRULE,"BTYP",Z)) Q:'Z S IBCT=IBCT+1,IB(364.41,IBCT,.01)=$P($G(^(Z,0)),U)
  1. ;
  1. D BTYP^IBCEF51(.IB,.IBOK,0)
  1. ;
  1. I IBOK D
  1. . N Z
  1. . S Z=0 F S Z=$O(^IBE(364.4,IBRULE,"BTYP",Z)) Q:'Z S DA=Z,DA(1)=IBRULE,DIK="^IBE(364.4,"_DA(1)_",""BTYP""," D ^DIK
  1. . D ADDBTYP(.IB,IBRULE)
  1. . D REBLD^IBCEF62
  1. D SUCCESS(IBOK)
  1. ;
  1. BTAQ S VALMBCK="R"
  1. Q
  1. ;
  1. INSCO(IBRULE) ; Allow user to edit rule's ins co data
  1. ; IBRULE = ien of rule - file 364.4
  1. ;
  1. G:'$G(IBRULE) INSCOQ
  1. N DA,DR,DIE,X,Y,Z,Z0,IB,IB0
  1. S DA=$G(IBRULE),DIE="^IBE(364.4,"
  1. S IB0=$G(^IBE(364.4,IBRULE,0)),IB(".07O")=$P(IB0,U,7)
  1. S DR=$S($P(IB0,U,3)'=2:".07;S Y=$S(X=1:""@10"",X=2:""@20"",1:""@99"");",1:"")_"@10;3;S Y=""@99"";@20;2;S Y=""@99"";@99"
  1. D ^DIE
  1. S IB(.07)=$P($G(^IBE(364.4,IBRULE,0)),U,7)
  1. ;
  1. I IB(".07O"),IB(".07O")'=IB(.07),IB(".07O")'=3 D ; Delete 'old' includes/excludes
  1. . S Z=$P("3^2",U,+IB(".07O")),Z0=0 F S Z0=$O(^IBE(364.4,IBRULE,Z,Z0)) Q:'Z0 S DA=Z0,DA(1)=IBRULE,DIK="^IBE(364.4,"_DA(1)_","_Z_"," D ^DIK
  1. ;
  1. ; If all ins cos selected, delete existing specific ones in/excluded
  1. I 'IB(.07)!(IB(.07)=3) D
  1. . Q:IB(".07O")=IB(.07)
  1. . F Z=2,3 I $O(^IBE(364.4,IBRULE,Z,0)) S Z0=0 F S Z0=$O(^IBE(364.4,IBRULE,Z,Z0)) Q:'Z0 S DA=Z0,DA(1)=IBRULE,DIK="^IBE(364.4,"_DA(1)_","_Z_"," D ^DIK
  1. E D
  1. . Q:$O(^IBE(364.4,IBRULE,$S(IB(.07)=1:3,1:2),0))
  1. . W !,"Warning ... no insurance companies chosen to "_$S(IB(.07)=1:"in",1:"ex")_"clude"
  1. . D QUIT^IBCEF5
  1. D REBLD^IBCEF6($G(IBACTIVE))
  1. ;
  1. INSCOQ S VALMBCK="R"
  1. Q
  1. ;
  1. MISC(IBRULE) ; Edit other misc fields for the rule
  1. ; IBRULE = ien of rule - file 364.4
  1. ;
  1. I $G(IBRULE) D
  1. . N DA,DR,DIE,X,Y,Z,Z0
  1. . S DA=$G(IBRULE),DIE="^IBE(364.4,"
  1. . S DR=".08;1;4"
  1. . D ^DIE
  1. . D REBLD^IBCEF6($G(IBACTIVE))
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. DISPRUL(IBRULE) ; Display rule selected
  1. ; IBRULE = ien of rule - file 364.4
  1. ;
  1. I '$G(IBRULE) D FULL^VALM1
  1. N DIOBEG,FR,TO,BY,DIC,DA,L,FLDS,DHD
  1. S (FR,TO)=$G(IBRULE),DHD="[IBCE RULE DISPLAY HEADER]"
  1. S L=0,BY="@RULE NUMBER",DIC="^IBE(364.4,",FLDS="[IBCE RULE DISPLAY]"
  1. S DIOBEG="W !"
  1. W !!
  1. D EN1^DIP
  1. DISPRQ S VALMBCK="R"
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. SUCCESS(IBOK) ; Display msg after add rule
  1. ; IBOK = 1 if successful, 0 if not
  1. ;
  1. N DIR,Y,X
  1. S DIR(0)="EA"
  1. W !
  1. I $G(IBOK) S DIR("A",1)="TRANSMISSION RULE(s) HAVE BEEN SUCCESSFULLY FILED"
  1. I '$G(IBOK) S DIR("A",1)="NO TRANSMISSION RULES ADDED"
  1. S DIR("A")="PRESS RETURN " D ^DIR K DIR
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ADDBTYP(IB,IBDA1) ; Add bill types in IB(364.41) to rule IBDA1
  1. ;
  1. N Z,Z0,IBC
  1. I $D(IB(364.41)) D
  1. . S IBC=0 F S IBC=$O(IB(364.41,IBC)) Q:'IBC D
  1. .. N DO,DD,DIC,DLAYGO,DA,X,Y
  1. .. S Z=.01 F S Z=$O(IB(364.41,IBC,Z)) Q:'Z S Z0=$G(IB(364.41,IBC,Z)) I Z0'="" D ;Bill type excepts
  1. ... S DIC("DR")=$G(DIC("DR"))_$S($G(DIC("DR"))="":"",1:";")_Z_"///"_Z0
  1. .. I '$D(^IBE(364.4,IBDA1,"BTYP",0)) S DIC("P")=$$GETSPEC^IBEFUNC(364.4,.1)
  1. .. S X=IB(364.41,IBC,.01)
  1. .. S DA(1)=IBDA1,DIC="^IBE(364.4,"_IBDA1_",""BTYP"",",DIC(0)="L",DLAYGO=364.4
  1. .. D FILE^DICN
  1. Q
  1. ;
  1. INSADD(IB,IBDA1) ; Add ins co exceptions from entries in
  1. ; IB(364.42 - exclude) or IB(364.43 - include) to rule IBDA1
  1. ;
  1. N Z,IBNODE,Z0
  1. F Z=364.42,364.43 S IBNODE=$E(Z,$L(Z)),Z0=0 F S Z0=$O(IB(Z,Z0)) Q:'Z0 D
  1. . N DO,DD,DIC,DLAYGO,DA
  1. . I '$D(^IBE(364.4,IBDA1,IBNODE,0)) S DIC("P")=$$GETSPEC^IBEFUNC(364.4,IBNODE)
  1. . S DA(1)=IBDA1,DIC="^IBE(364.4,"_IBDA1_","_IBNODE_",",DIC(0)="L",DLAYGO=364.4,X=Z0
  1. . D FILE^DICN K DIC
  1. Q
  1. ;
  1. BTDTOK(IBRULE,IBBT,IBDTYP,X) ; Check bill type date is consistent for rule
  1. ; IBRULE = ien of rule - file 364.4
  1. ; IBBT = ien of bill type in rule IBRULE (optional if check at top level)
  1. ; IBDTYP = 1 for active date check, 2 for inactive date check
  1. ; X = Value of date being validated
  1. ;
  1. ; Function returns 1 if consistencies are OK, 0 if not
  1. ;
  1. N IBOK,IBPCK,Z
  1. S IBOK=1
  1. S IBPCK=$S(IBDTYP=1:2,1:6)
  1. ;
  1. ; Check for consistency at rule level first
  1. ;
  1. ; Active dt must not be after rule's inact dt
  1. I IBDTYP=1,$P($G(^IBE(364.4,IBRULE,0)),U,6),X>$P(^(0),U,6) S Z=$$FMTE^XLFDT($P($G(^IBE(364.4,IBRULE,0)),U,6)) D EN^DDIOL("CANNOT BE AFTER RULE'S INACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 G BTDTQ
  1. ;
  1. ; Inact dt must not be prior to rule's active dt
  1. I IBDTYP=2,$S('$P($G(^IBE(364.4,IBRULE,0)),U,2):'$G(IBBT),1:X<$P($G(^(0)),U,2)) S Z=$$FMTE^XLFDT($P($G(^IBE(364.4,IBRULE,0)),U,2)) D EN^DDIOL("CANNOT BE BEFORE RULE'S ACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 G BTDTQ
  1. ;
  1. I $G(IBBT) D ; Check for consistency at the bill type level
  1. . ; Active dt at bt level must be prior to inactive dt
  1. . I IBDTYP=1,$P($G(^IBE(364.4,IBRULE,"IBTYP",IBBT,0)),U,3),X>$P(^(0),U,3) S Z=$$FMTE^XLFDT($P(^IBE(364.4,IBRULE,"IBTYP",IBBT,0),U,3)) D EN^DDIOL("MUST BE PRIOR TO BILL TYPE'S INACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 Q
  1. . ; Inactive dt at bt level must be after active dt
  1. . I IBDTYP=2,$S('$P($G(^IBE(364.4,IBRULE,"IBTYP",IBBT,0)),U,2):1,1:X<$P(^(0),U,2)) S Z=$$FMTE^XLFDT($P($G(^IBE(364.4,IBRULE,"IBTYP",IBBT,0)),U,2)) D EN^DDIOL("MUST BE AFTER BILL TYPE'S ACTIVE DATE OF "_$S('Z:"<MISSING>",1:Z),,"!!") S IBOK=0 Q
  1. . ;
  1. . S Z=0
  1. . F S Z=$O(^IBE(364.4,IBRULE,"BTYP",Z)) Q:'Z S Z0=$G(^(Z,0)) D Q:'IBOK
  1. .. I $P(Z0,U,IBDTYP+1),$S(IBDTYP=1:X<$P(Z0,U,2),1:X>$P(Z0,U,3)) D EN^DDIOL("CHANGE WOULD INVALIDATE BILL TYPE RESTRICTION DATE",,"!!") S IBOK=0
  1. BTDTQ Q IBOK
  1. ;