IBCEF62 ;ALB/TMP - EDI TRANSMISSION RULES BT RESTRICTIONS DISPLAY ;30-APR-99
;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
;
EN ; -- main entry point for IBCE RULE BT RESTRICT
D EN^VALM("IBCE RULE BT RESTRICT")
Q
;
HDR ; -- header code
N IB0
Q:'$G(IBRULE)
S IB0=$G(^IBE(364.4,IBRULE,0))
S VALMHDR(1)=IORVON_"BILL TYPE RESTRICTIONS FOR RULE #"_$P(IB0,U)_IORVOFF
S VALMHDR(2)=$J("",4)_"Transmit type: "_$S($P(IB0,U,3)=1:"EDI ",$P(IB0,U,3)=2:"MRA ",1:"BOTH")_$J("",8)_" Form Type : "_$S($P(IB0,U,5)=1:"INST",$P(IB0,U,5)=2:"PROF",1:"BOTH")
S VALMHDR(2)=VALMHDR(2)_" Ins Co Option: "_$S($P(IB0,U,7)=1:"INCLUDE",$P(IB0,U,7)=2:"EXCLUDE",1:"ALL ")
S VALMHDR(3)=$J("",4)_"Active Date : "_$E($$EXPAND^IBTRE(364.4,.02,$P(IB0,U,2))_$J("",12),1,12)_" Inactive Date: "_$E($$EXPAND^IBTRE(364.4,.06,$P(IB0,U,6))_$J("",12),1,12)
S VALMHDR(4)=$J("",4)_$P(IB0,U,8)
Q
;
INIT ; -- init variables and list array
N IBI,IBR,IBRT
S VALMCNT=0,VALMBG=1
; -- build list of rule's bill type restrictions
D REBLD
Q
;
REBLD ; Set up formatted global
;
N IBI,IBBT,IBCNT,X,IB0,Z
D CLEAN^VALM10
K ^TMP("IBCE-BT",$J),^TMP("IBCE-BTDX",$J)
I '$G(IBRULE) Q
S IBBT="",X="",(VALMCNT,IBCNT)=0
F S IBBT=$O(^IBE(364.4,IBRULE,"BTYP","B",IBBT),-1) Q:IBBT="" S IBI=0 F S IBI=$O(^IBE(364.4,IBRULE,"BTYP","B",IBBT,IBI)) Q:'IBI S IB0=$G(^IBE(364.4,IBRULE,"BTYP",IBI,0)) D
. S IBCNT=IBCNT+1
. S X=$$SETFLD^VALM1(" "_IBCNT,X,"NUMBER")
. S X=$$SETFLD^VALM1(" "_IBBT,X,"BILL TYPE")
. S X=$$SETFLD^VALM1($$EXPAND^IBTRE(364.41,.02,$P(IB0,U,2)),X,"ACT")
. S X=$$SETFLD^VALM1($$EXPAND^IBTRE(364.41,.03,$P(IB0,U,3)),X,"INACT")
. D SET(X,IBCNT,IBI)
;
I '$D(^TMP("IBCE-BT",$J)) S VALMCNT=2,IBCNT=2,^TMP("IBCE-BT",$J,1,0)=" ",^TMP("IBCE-BT",$J,2,0)=" No Bill Type Restrictions Found",^TMP("IBCE-BT",$J,"IDX",1,1)="",^TMP("IBCE-BT",$J,"IDX",2,2)=""
Q
;
SET(X,IBCNT,IBIEN) ;
; X = Text to set into display global
; IBCNT = the count of the entries in display
; IBIEN = ien of rule's bill type restriction being displayed
;
S VALMCNT=VALMCNT+1,^TMP("IBCE-BT",$J,VALMCNT,0)=X
D SET^VALM10(VALMCNT,X,IBCNT)
S ^TMP("IBCE-BTDX",$J,VALMCNT)=IBIEN
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCE-BT",$J),^TMP("IBCE-BTDX",$J),IBRULE
D FULL^VALM1
Q
;
EXPND ; -- expand code
Q
;
SUCCBT ; Display success message after bill type restriction delete
;
N DIR,Y,X
S DIR(0)="EA"
W !
S DIR("A",1)="THE BILL TYPE RESTRICTION(S) WAS/WERE DELETED"
S DIR("A")="PRESS RETURN " D ^DIR K DIR
S VALMBCK="R"
Q
;
BTDEL(IBRULE) ; Delete bill type restriction
; IBRULE = the ien of the rule being processed in file 364.4
;
; Function returns 1 if successful, 0 if not
;
N IBOK,DA,DIK,Y,X,IBHT,Z,Z0,VALMY,IBCT,IBX
;
S IBOK=0,IBCT=0
D SEL^IBCEF61(.VALMY)
G:'$O(VALMY(0)) BTDQ ; None selected
;
S IBX=0 F S IBX=$O(VALMY(IBX)) Q:'IBX S Z0=+$G(^TMP("IBCE-BTDX",$J,IBX)),Z=$P($G(^IBE(364.4,IBRULE,"BTYP",Z0,0)),U) I Z'="" S IBX(Z)=Z0,IBCT=IBCT+1
; First check that delete will leave the rest of the restrictions valid
S Z="" F S Z=$O(^IBE(364.4,IBRULE,"BTYP","B",Z)) Q:Z="" F Z0=0:0 S Z0=$O(^IBE(364.4,IBRULE,"BTYP","B",Z,Z0)) Q:'Z0 I '$D(IBX(Z)) S IB0=$G(^IBE(364.4,IBRULE,"BTYP",Z0,0)) I IB0'="" S IBHT($P(IB0,U))=Z0 ;Extract all bill types
;
S Z="",IBOK=1
F S Z=$O(IBHT(Z)) Q:Z="" D Q:'IBOK
. N IBB
. M IBB=IBHT K IBB(Z)
. S IBOK=$$BTOK^IBCEF51(Z,.IBB,1)
. I 'IBOK D
.. S DIR(0)="EA",DIR("A",1)="Bill type"_$S(IBCT=1:"",1:"s")_" not deleted - deleting "_$S(IBCT=1:"this restriction",1:"these restrictions")_" would cause an inconsistency",DIR("A")="Press return: "
.. D ^DIR K DIR
;
I IBOK D
. S Z="" F S Z=$O(IBX(Z)) Q:Z="" S DA=IBX(Z),DA(1)=IBRULE,DIK="^IBE(364.4,"_DA(1)_",""BTYP""," I DA D ^DIK
. D REBLD
;
BTDQ S VALMBCK="R"
Q IBOK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF62 3911 printed Nov 22, 2024@17:20:15 Page 2
IBCEF62 ;ALB/TMP - EDI TRANSMISSION RULES BT RESTRICTIONS DISPLAY ;30-APR-99
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
+2 ;
EN ; -- main entry point for IBCE RULE BT RESTRICT
+1 DO EN^VALM("IBCE RULE BT RESTRICT")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW IB0
+2 if '$GET(IBRULE)
QUIT
+3 SET IB0=$GET(^IBE(364.4,IBRULE,0))
+4 SET VALMHDR(1)=IORVON_"BILL TYPE RESTRICTIONS FOR RULE #"_$PIECE(IB0,U)_IORVOFF
+5 SET VALMHDR(2)=$JUSTIFY("",4)_"Transmit type: "_$SELECT($PIECE(IB0,U,3)=1:"EDI ",$PIECE(IB0,U,3)=2:"MRA ",1:"BOTH")_$JUSTIFY("",8)_" Form Type : "_$SELECT($PIECE(IB0,U,5)=1:"INST",$PIECE(IB0,U,5)=2:"PROF",1:"BOTH")
+6 SET VALMHDR(2)=VALMHDR(2)_" Ins Co Option: "_$SELECT($PIECE(IB0,U,7)=1:"INCLUDE",$PIECE(IB0,U,7)=2:"EXCLUDE",1:"ALL ")
+7 SET VALMHDR(3)=$JUSTIFY("",4)_"Active Date : "_$EXTRACT($$EXPAND^IBTRE(364.4,.02,$PIECE(IB0,U,2))_$JUSTIFY("",12),1,12)_" Inactive Date: "_$EXTRACT($$EXPAND^IBTRE(364.4,.06,$PIECE(IB0,U,6))_$JUSTIFY("",12),1,12)
+8 SET VALMHDR(4)=$JUSTIFY("",4)_$PIECE(IB0,U,8)
+9 QUIT
+10 ;
INIT ; -- init variables and list array
+1 NEW IBI,IBR,IBRT
+2 SET VALMCNT=0
SET VALMBG=1
+3 ; -- build list of rule's bill type restrictions
+4 DO REBLD
+5 QUIT
+6 ;
REBLD ; Set up formatted global
+1 ;
+2 NEW IBI,IBBT,IBCNT,X,IB0,Z
+3 DO CLEAN^VALM10
+4 KILL ^TMP("IBCE-BT",$JOB),^TMP("IBCE-BTDX",$JOB)
+5 IF '$GET(IBRULE)
QUIT
+6 SET IBBT=""
SET X=""
SET (VALMCNT,IBCNT)=0
+7 FOR
SET IBBT=$ORDER(^IBE(364.4,IBRULE,"BTYP","B",IBBT),-1)
if IBBT=""
QUIT
SET IBI=0
FOR
SET IBI=$ORDER(^IBE(364.4,IBRULE,"BTYP","B",IBBT,IBI))
if 'IBI
QUIT
SET IB0=$GET(^IBE(364.4,IBRULE,"BTYP",IBI,0))
Begin DoDot:1
+8 SET IBCNT=IBCNT+1
+9 SET X=$$SETFLD^VALM1(" "_IBCNT,X,"NUMBER")
+10 SET X=$$SETFLD^VALM1(" "_IBBT,X,"BILL TYPE")
+11 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(364.41,.02,$PIECE(IB0,U,2)),X,"ACT")
+12 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(364.41,.03,$PIECE(IB0,U,3)),X,"INACT")
+13 DO SET(X,IBCNT,IBI)
End DoDot:1
+14 ;
+15 IF '$DATA(^TMP("IBCE-BT",$JOB))
SET VALMCNT=2
SET IBCNT=2
SET ^TMP("IBCE-BT",$JOB,1,0)=" "
SET ^TMP("IBCE-BT",$JOB,2,0)=" No Bill Type Restrictions Found"
SET ^TMP("IBCE-BT",$JOB,"IDX",1,1)=""
SET ^TMP("IBCE-BT",$JOB,"IDX",2,2)=""
+16 QUIT
+17 ;
SET(X,IBCNT,IBIEN) ;
+1 ; X = Text to set into display global
+2 ; IBCNT = the count of the entries in display
+3 ; IBIEN = ien of rule's bill type restriction being displayed
+4 ;
+5 SET VALMCNT=VALMCNT+1
SET ^TMP("IBCE-BT",$JOB,VALMCNT,0)=X
+6 DO SET^VALM10(VALMCNT,X,IBCNT)
+7 SET ^TMP("IBCE-BTDX",$JOB,VALMCNT)=IBIEN
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBCE-BT",$JOB),^TMP("IBCE-BTDX",$JOB),IBRULE
+2 DO FULL^VALM1
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SUCCBT ; Display success message after bill type restriction delete
+1 ;
+2 NEW DIR,Y,X
+3 SET DIR(0)="EA"
+4 WRITE !
+5 SET DIR("A",1)="THE BILL TYPE RESTRICTION(S) WAS/WERE DELETED"
+6 SET DIR("A")="PRESS RETURN "
DO ^DIR
KILL DIR
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
BTDEL(IBRULE) ; Delete bill type restriction
+1 ; IBRULE = the ien of the rule being processed in file 364.4
+2 ;
+3 ; Function returns 1 if successful, 0 if not
+4 ;
+5 NEW IBOK,DA,DIK,Y,X,IBHT,Z,Z0,VALMY,IBCT,IBX
+6 ;
+7 SET IBOK=0
SET IBCT=0
+8 DO SEL^IBCEF61(.VALMY)
+9 ; None selected
if '$ORDER(VALMY(0))
GOTO BTDQ
+10 ;
+11 SET IBX=0
FOR
SET IBX=$ORDER(VALMY(IBX))
if 'IBX
QUIT
SET Z0=+$GET(^TMP("IBCE-BTDX",$JOB,IBX))
SET Z=$PIECE($GET(^IBE(364.4,IBRULE,"BTYP",Z0,0)),U)
IF Z'=""
SET IBX(Z)=Z0
SET IBCT=IBCT+1
+12 ; First check that delete will leave the rest of the restrictions valid
+13 ;Extract all bill types
SET Z=""
FOR
SET Z=$ORDER(^IBE(364.4,IBRULE,"BTYP","B",Z))
if Z=""
QUIT
FOR Z0=0:0
SET Z0=$ORDER(^IBE(364.4,IBRULE,"BTYP","B",Z,Z0))
if 'Z0
QUIT
IF '$DATA(IBX(Z))
SET IB0=$GET(^IBE(364.4,IBRULE,"BTYP",Z0,0))
IF IB0'=""
SET IBHT($PIECE(IB0,U))=Z0
+14 ;
+15 SET Z=""
SET IBOK=1
+16 FOR
SET Z=$ORDER(IBHT(Z))
if Z=""
QUIT
Begin DoDot:1
+17 NEW IBB
+18 MERGE IBB=IBHT
KILL IBB(Z)
+19 SET IBOK=$$BTOK^IBCEF51(Z,.IBB,1)
+20 IF 'IBOK
Begin DoDot:2
+21 SET DIR(0)="EA"
SET DIR("A",1)="Bill type"_$SELECT(IBCT=1:"",1:"s")_" not deleted - deleting "_$SELECT(IBCT=1:"this restriction",1:"these restrictions")_" would cause an inconsistency"
SET DIR("A")="Press return: "
+22 DO ^DIR
KILL DIR
End DoDot:2
End DoDot:1
if 'IBOK
QUIT
+23 ;
+24 IF IBOK
Begin DoDot:1
+25 SET Z=""
FOR
SET Z=$ORDER(IBX(Z))
if Z=""
QUIT
SET DA=IBX(Z)
SET DA(1)=IBRULE
SET DIK="^IBE(364.4,"_DA(1)_",""BTYP"","
IF DA
DO ^DIK
+26 DO REBLD
End DoDot:1
+27 ;
BTDQ SET VALMBCK="R"
+1 QUIT IBOK
+2 ;
