IBCEF6 ;ALB/TMP - EDI TRANSMISSION RULES DISPLAY ;28-APR-99
;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
;
EN ; -- main entry point for IBCE RULES
N IBACTIVE
S DIR("A")="Press RETURN to continue: ",DIR("A",1)="",$P(DIR("A",1),"*",54)="",DIR("A",1)=$J("",10)_DIR("A",1)
S DIR("A",2)=$J("",10)_"* WARNING - MAKING CHANGES TO THE TRANSMISSION *",DIR("A",3)=$J("",10)_"* RULES USING THIS OPTION CAN SERIOUSLY AFFECT THE *"
S DIR("A",4)=$J("",10)_"* SITE'S ABILITY TO BILL. BE EXTREMELY CAUTIOUS *"
S DIR("A",5)=$J("",10)_"* WHEN USING THIS OPTION. *"
S DIR("A",6)=DIR("A",1),DIR("A",7)=" "
S DIR(0)="EA"
D ^DIR K DIR
I 'Y G ENQ
D EN^VALM("IBCE RULES")
ENQ Q
;
HDR ; -- header code
S VALMHDR(1)=" "
S VALMHDR(2)=" FORM TRANSMIT INSURANCE RULE"
S VALMHDR(3)=" # TYPE TYPE OPTION NUM SHORT DESCRIPTION"_$J("",30)_"ACTIVE DATE INACTIVE DATE"
Q
;
INIT ; -- init variables and list array
N IBI,IBR,IBRT
S VALMCNT=0,VALMBG=1
; -- build list of rules
D REBLD(0)
Q
;
REBLD(IBACTIVE) ; Set up formatted global
;
N IBI,IBR,IBS,IBRT,IBCNT,X,IB0,IBIN,IBNEXT,TEXT,Z
D CLEAN^VALM10
K ^TMP("IBCE-RULE",$J),^TMP("IBCE-RULEDX",$J)
S (IBI,IBR)=0
F S IBI=$O(^IBE(364.4,IBI)) Q:'IBI S IB0=$G(^(IBI,0)) D
. S IBRT=+$P(IB0,U,11)
. ;Extract rules by rule type and keep inactive rules at end
. S IBIN=$S($P(IB0,U,2)&($P(IB0,U,2)>DT):800,$P(IB0,U,6)&($P(IB0,U,6)'>DT):900,1:0) ; Is rule inactive?
. Q:IBIN&$G(IBACTIVE) ; Only active rules displayed
. S IBNEXT=$O(IBR(IBRT,800),-1)+1
. I IBIN D
.. S IBNEXT=$O(IBR(IBRT,IBIN+99),-1)+1
.. I IBNEXT<IBIN S IBNEXT=IBIN
. S IBR(IBRT,IBNEXT)=IBI
;
S (VALMCNT,IBCNT)=0,IBRT=""
F S IBRT=$O(IBR(IBRT)) Q:IBRT="" D
. ; -- add rule type to list
. ; Add 1 blank line between types
. I $O(IBR(""))'=IBRT D SET(" ",.VALMCNT,IBCNT)
. S X="- "_$$EXPAND^IBTRE(364.4,.11,IBRT)_" -"
. S IBS=(80-$L(X))\2
. S X=$J("",IBS)_X
. D SET(X,.VALMCNT,$S(IBCNT:IBCNT,1:1))
. D CNTRL^VALM10(VALMCNT,IBS+1,$L(X)-IBS,IORVON,IORVOFF)
. D SET(" ",.VALMCNT,$S(IBCNT:IBCNT,1:1))
. S IBS=0 F S IBS=$O(IBR(IBRT,IBS)) Q:'IBS S IBRULE=+$G(IBR(IBRT,IBS)) I IBRULE D
.. S IB0=$G(^IBE(364.4,IBRULE,0))
.. S X=""
.. S IBCNT=IBCNT+1
.. S X=$J(IBCNT,3)_" "_$S($P(IB0,U,5)=1:"INST",$P(IB0,U,5)=2:"PROF",1:"BOTH")_" "_$E($S($P(IB0,U,3)=1:"EDI ONLY",$P(IB0,U,3)=2:"MRA ONLY",1:"BOTH EDI/MRA")_$J("",14),1,14)
.. S X=X_$E($S($P(IB0,U,7)=1:"INCLUDES",$P(IB0,U,7)=2:"EXCLUDES",1:"ALL")_$J("",11),1,11)_$E($P(IB0,U)_$S(IBS'<800:"*",1:"")_$J("",6),1,6)
.. S X=X_$E($P(IB0,U,8)_$J("",47),1,47)_$E($$EXPAND^IBTRE(364.4,.02,$P(IB0,U,2))_$J("",15),1,15)_$$EXPAND^IBTRE(364.4,.06,$P(IB0,U,6))
.. D SET(X,.VALMCNT,IBCNT,IBRULE)
. S VALMSG=$S('$G(IBACTIVE):"Rule #'s followed by an * are currently inactive",1:"Only currently active rules are displayed")
;
I '$D(^TMP("IBCE-RULE",$J)) S VALMCNT=2,IBCNT=2,^TMP("IBCE-RULE",$J,1,0)=" ",^TMP("IBCE-RULE",$J,2,0)=" No "_$S('$G(IBACTIVE):"",1:"Active")_" Transmission Rules Found",^TMP("IBCE-RULE",$J,"IDX",1,1)="",^TMP("IBCE-RULE",$J,"IDX",2,2)=""
Q
;
SET(X,VALMCNT,IBCNT,IBRULE) ;
; X = Text to set into display global
; VALMCNT = returned if passed by ref = the last line set in display
; IBCNT = entry number to use if the line is selectable; non-select = 0
; IBRULE = ien of rule being displayed
;
S VALMCNT=VALMCNT+1,^TMP("IBCE-RULE",$J,VALMCNT,0)=X
D SET^VALM10(VALMCNT,X,IBCNT)
I $G(IBRULE) D
. S ^TMP("IBCE-RULEDX",$J,IBCNT)=VALMCNT_U_IBRULE
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBCE-RULE",$J),^TMP("IBCE-RULEDX",$J),IBRULE
D FULL^VALM1
Q
;
EXPND ; -- expand code
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF6 3781 printed Apr 09, 2024@21:20:20 Page 2
IBCEF6 ;ALB/TMP - EDI TRANSMISSION RULES DISPLAY ;28-APR-99
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
+2 ;
EN ; -- main entry point for IBCE RULES
+1 NEW IBACTIVE
+2 SET DIR("A")="Press RETURN to continue: "
SET DIR("A",1)=""
SET $PIECE(DIR("A",1),"*",54)=""
SET DIR("A",1)=$JUSTIFY("",10)_DIR("A",1)
+3 SET DIR("A",2)=$JUSTIFY("",10)_"* WARNING - MAKING CHANGES TO THE TRANSMISSION *"
SET DIR("A",3)=$JUSTIFY("",10)_"* RULES USING THIS OPTION CAN SERIOUSLY AFFECT THE *"
+4 SET DIR("A",4)=$JUSTIFY("",10)_"* SITE'S ABILITY TO BILL. BE EXTREMELY CAUTIOUS *"
+5 SET DIR("A",5)=$JUSTIFY("",10)_"* WHEN USING THIS OPTION. *"
+6 SET DIR("A",6)=DIR("A",1)
SET DIR("A",7)=" "
+7 SET DIR(0)="EA"
+8 DO ^DIR
KILL DIR
+9 IF 'Y
GOTO ENQ
+10 DO EN^VALM("IBCE RULES")
ENQ QUIT
+1 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" "
+2 SET VALMHDR(2)=" FORM TRANSMIT INSURANCE RULE"
+3 SET VALMHDR(3)=" # TYPE TYPE OPTION NUM SHORT DESCRIPTION"_$JUSTIFY("",30)_"ACTIVE DATE INACTIVE DATE"
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 NEW IBI,IBR,IBRT
+2 SET VALMCNT=0
SET VALMBG=1
+3 ; -- build list of rules
+4 DO REBLD(0)
+5 QUIT
+6 ;
REBLD(IBACTIVE) ; Set up formatted global
+1 ;
+2 NEW IBI,IBR,IBS,IBRT,IBCNT,X,IB0,IBIN,IBNEXT,TEXT,Z
+3 DO CLEAN^VALM10
+4 KILL ^TMP("IBCE-RULE",$JOB),^TMP("IBCE-RULEDX",$JOB)
+5 SET (IBI,IBR)=0
+6 FOR
SET IBI=$ORDER(^IBE(364.4,IBI))
if 'IBI
QUIT
SET IB0=$GET(^(IBI,0))
Begin DoDot:1
+7 SET IBRT=+$PIECE(IB0,U,11)
+8 ;Extract rules by rule type and keep inactive rules at end
+9 ; Is rule inactive?
SET IBIN=$SELECT($PIECE(IB0,U,2)&($PIECE(IB0,U,2)>DT):800,$PIECE(IB0,U,6)&($PIECE(IB0,U,6)'>DT):900,1:0)
+10 ; Only active rules displayed
if IBIN&$GET(IBACTIVE)
QUIT
+11 SET IBNEXT=$ORDER(IBR(IBRT,800),-1)+1
+12 IF IBIN
Begin DoDot:2
+13 SET IBNEXT=$ORDER(IBR(IBRT,IBIN+99),-1)+1
+14 IF IBNEXT<IBIN
SET IBNEXT=IBIN
End DoDot:2
+15 SET IBR(IBRT,IBNEXT)=IBI
End DoDot:1
+16 ;
+17 SET (VALMCNT,IBCNT)=0
SET IBRT=""
+18 FOR
SET IBRT=$ORDER(IBR(IBRT))
if IBRT=""
QUIT
Begin DoDot:1
+19 ; -- add rule type to list
+20 ; Add 1 blank line between types
+21 IF $ORDER(IBR(""))'=IBRT
DO SET(" ",.VALMCNT,IBCNT)
+22 SET X="- "_$$EXPAND^IBTRE(364.4,.11,IBRT)_" -"
+23 SET IBS=(80-$LENGTH(X))\2
+24 SET X=$JUSTIFY("",IBS)_X
+25 DO SET(X,.VALMCNT,$SELECT(IBCNT:IBCNT,1:1))
+26 DO CNTRL^VALM10(VALMCNT,IBS+1,$LENGTH(X)-IBS,IORVON,IORVOFF)
+27 DO SET(" ",.VALMCNT,$SELECT(IBCNT:IBCNT,1:1))
+28 SET IBS=0
FOR
SET IBS=$ORDER(IBR(IBRT,IBS))
if 'IBS
QUIT
SET IBRULE=+$GET(IBR(IBRT,IBS))
IF IBRULE
Begin DoDot:2
+29 SET IB0=$GET(^IBE(364.4,IBRULE,0))
+30 SET X=""
+31 SET IBCNT=IBCNT+1
+32 SET X=$JUSTIFY(IBCNT,3)_" "_$SELECT($PIECE(IB0,U,5)=1:"INST",$PIECE(IB0,U,5)=2:"PROF",1:"BOTH")_" "_$EXTRACT($SELECT($PIECE(IB0,U,3)=1:"EDI ONLY",$PIECE(IB0,U,3)=2:"MRA ONLY",1:"BOTH EDI/MRA")_$JUSTIFY("",14),1,14)
+33 SET X=X_$EXTRACT($SELECT($PIECE(IB0,U,7)=1:"INCLUDES",$PIECE(IB0,U,7)=2:"EXCLUDES",1:"ALL")_$JUSTIFY("",11),1,11)_$EXTRACT($PIECE(IB0,U)_$SELECT(IBS'<800:"*",1:"")_$JUSTIFY("",6),1,6)
+34 SET X=X_$EXTRACT($PIECE(IB0,U,8)_$JUSTIFY("",47),1,47)_$EXTRACT($$EXPAND^IBTRE(364.4,.02,$PIECE(IB0,U,2))_$JUSTIFY("",15),1,15)_$$EXPAND^IBTRE(364.4,.06,$PIECE(IB0,U,6))
+35 DO SET(X,.VALMCNT,IBCNT,IBRULE)
End DoDot:2
+36 SET VALMSG=$SELECT('$GET(IBACTIVE):"Rule #'s followed by an * are currently inactive",1:"Only currently active rules are displayed")
End DoDot:1
+37 ;
+38 IF '$DATA(^TMP("IBCE-RULE",$JOB))
SET VALMCNT=2
SET IBCNT=2
SET ^TMP("IBCE-RULE",$JOB,1,0)=" "
SET ^TMP("IBCE-RULE",$JOB,2,0)=" No "_$SELECT('$GET(IBACTIVE):"",1:"Active")_" Transmission Rules Found"
SET ^TMP("IBCE-RULE",$JOB,"IDX",1,1)=""
SET ^TMP("IBCE-RULE",$JOB,"IDX",2,2)=""
+39 QUIT
+40 ;
SET(X,VALMCNT,IBCNT,IBRULE) ;
+1 ; X = Text to set into display global
+2 ; VALMCNT = returned if passed by ref = the last line set in display
+3 ; IBCNT = entry number to use if the line is selectable; non-select = 0
+4 ; IBRULE = ien of rule being displayed
+5 ;
+6 SET VALMCNT=VALMCNT+1
SET ^TMP("IBCE-RULE",$JOB,VALMCNT,0)=X
+7 DO SET^VALM10(VALMCNT,X,IBCNT)
+8 IF $GET(IBRULE)
Begin DoDot:1
+9 SET ^TMP("IBCE-RULEDX",$JOB,IBCNT)=VALMCNT_U_IBRULE
End DoDot:1
+10 QUIT
+11 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBCE-RULE",$JOB),^TMP("IBCE-RULEDX",$JOB),IBRULE
+2 DO FULL^VALM1
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
