- 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 Feb 18, 2025@23:36:34 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 ;