IBCEF5 ;ALB/TMP - MRA/EDI ACTIVATED UTILITIES ;06-FEB-96
;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
;
ADDRULE() ; Add a new rule to the EDI transmission rules file
; Function returns the entry number of the new rule or
; 0 if no rule added
;
N DIR,X,Y,IBD,IBS,IBOK,IBDA1,IBC,DIC,DA,DR,DIE,IB,DO,DD,DLAYGO
;
D FULL^VALM1
S IBOK=1
;
L +^IBE(364.4,0):10
I '$T S IBOK=0 W !,"FILE LOCKED ... TRY AGAIN LATER" S IBOK=0 G ADDQ
S X=$O(^IBE(364.4,"A"),-1)
F S X=X+1 I '$D(^IBE(364.4,X,0)) S DIC="^IBE(364.4,",DIC(0)="L",DLAYGO=364.4,DIC("DR")="10.01////"_DUZ_";10.02///"_$$NOW^XLFDT D FILE^DICN S IBDA1=+Y K DLAYGO,DIC Q
L -^IBE(364.4,0)
I IBDA1'>0 S IBOK=0 G ADDQ
K DIR
S DIR(0)="364.4,.11A",DIR("A")="New Rule's TYPE OF RULE: "
D ^DIR K DIR
I $D(DIRUT) S IBOK=0 G ADDQ ;Required
S IB(.11)=+Y
I +Y=0 W !,"YOU ARE ADDING A RULE THAT WILL ONLY ALLOW THE TRANSMISSION OF BILLS WHOSE",!," FORM TYPE IS INCLUDED IN THIS RULE."
;
S IB(.03)=2 ;MRA ONLY
I IB(.11)'=2 D G:'IBOK ADDQ
. S DIR(0)="364.4,.03A^^I X=2 K X",DIR("A")="New Rule's TRANSMISSION TYPE: "
. D ^DIR K DIR,DA
. I Y'>0 S IBOK=0 K IB(.03) ;Required
. S IB(.03)=+Y
;
S DIR("A")=$S(IB(.11)'=0:"APPLY RULE ONLY TO BILLS THAT ARE (I)NSTITUTIONAL, (P)ROFESSIONAL, OR (B)OTH: ",1:"ONLY TRANSMIT (I)NSTITUTIONAL, (P)ROFESSIONAL, OR (B)OTH: ")
S DIR(0)="SAM^I:INSTITUTIONAL ONLY;P:PROFESSIONAL ONLY;B:BOTH TYPES"
D ^DIR K DIR,DA
I "IPB"'[Y S IBOK=0 G ADDQ
S IB(.05)=$S(Y="I":1,Y="P":2,1:3)
;
;S DIR("A")="APPLY RULE ONLY TO BILLS THAT ARE (I)NPATIENT, (O)UTPATIENT, OR (B)OTH: "
;S DIR(0)="SAM^I:INPATIENT;OUTPATIENT;B:BOTH"
;D ^DIR K DIR,DA
;I "IPB"'[Y S IBOK=0 G ADDQ
;S IB(.04)=$S(Y="I":1,Y="P":2,1:3)
S IB(.04)=3
;
W !
;
S IBS="",$P(IBS,"*",36)=""
S DIR("A",1)=IBS
S DIR("A",2)="THIS RULE WILL ONLY APPLY TO BILLS THAT MATCH ALL OF THE FOLLOWING CONDITIONS:"
S IBD=2
I IB(.11)'=2 D
. S IBD=IBD+1
. S DIR("A",IBD)=$J("",5)_"BILL IS "_$S(IB(.03)<3:"AN "_$P("EDI^MRA",U,+IB(.03)),1:"EITHER AN EDI OR MRA")_" BILL AND IS ALSO "
. S Z=$S(IB(.11)=0:IB(.05)#2+1,1:+IB(.05))
. S DIR("A",IBD)=DIR("A",IBD)_$S(IB(.05)<3:$P("AN INSTITUTIONAL^A PROFESSIONAL",U,Z),1:"EITHER A PROFESSIONAL OR INSTITUTIONAL")_" BILL"
.;S IBD=IBD+1,DIR("A",IBD)=$J("",5)_"AND "_$S(IB(.04)<3:"IS ALSO AN "_$P("INPATIENT^OUTPATIENT",U,+IB(.04)),1:"IS EITHER AN INPATIENT OR OUTPATIENT")_" BILL."
. S IBD=IBD+1,DIR("A",IBD)=""
. S IBD=IBD+1,DIR("A",IBD)="NOTE: RULE WILL BE IGNORED FOR ANY BILLS THAT DO NOT MATCH ALL THE CONDITIONS"
. ;
. I IB(.11)=0 D INSINC(.IBD)
. ;
. I IB(.11)=1 D
.. D INSINC(.IBD),RTINC(.IBD)
. ;
. I IB(.11)=9 D
.. S IBD=IBD+1,DIR("A",IBD)=""
.. D INSINC(.IBD)
;
I IB(.11)=2 D
. S IBD=IBD+1,DIR("A",IBD)=$J("",5)_"BILL IS AN MRA BILL"
. S IBD=IBD+1,DIR("A",IBD)=$J("",5)_"AND IS ALSO "_$S(IB(.05)<3:$P("AN INSTITUTIONAL^A PROFESSIONAL",U,+IB(.05)),1:"EITHER A PROFESSIONAL OR INSTITUTIONAL")_" BILL"
.;S IBD=IBD+1,DIR("A",IBD)=$J("",7)_"AND "_$S(IB(.04)<3:"IS ALSO AN "_$P("INPATIENT^OUTPATIENT",U,+IB(.04)),1:"IS EITHER AN INPATIENT OR OUTPATIENT")_" BILL"
. S IBD=IBD+1,DIR("A",IBD)=$J("",5)_"AND ALSO HAS A NEXT INSURANCE THAT HAS BEEN INCLUDED IN THE"
. S IBD=IBD+1,DIR("A",IBD)=$J("",8)_"'INSURANCE COMPANIES INCLUDED' LIST FOR THIS RULE."
. S IBD=IBD+1,DIR("A",IBD)=""
. S IBD=IBD+1,DIR("A",IBD)="NOTE: THIS RULE WILL BE IGNORED FOR ANY BILL THAT DOES NOT MATCH"
. S IBD=IBD+1,DIR("A",IBD)=" ALL OF THESE CONDITIONS."
. S IBD=IBD+1,DIR("A",IBD)=""
. S IBD=IBD+1,DIR("A",IBD)="THE EFFECT OF THIS RULE WILL BE: IF A BILL MATCHES ALL OF THE ABOVE CONDITIONS,"
. S IBD=IBD+1,DIR("A",IBD)="THE REQUEST AND RECEIPT OF AN MRA WILL NOT BE ALLOWED."
S IBD=IBD+1,DIR("A",IBD)=IBS
;
S DIR("A")="IS THIS CORRECT? "
S DIR(0)="YA",DIR("B")="YES"
D ^DIR K DIR
I 'Y S IBOK=0 G ADDQ
;
W !
;
; Combine inpatient/outpatient and inst/prof checks
S IB(.05,"IN")=$S(IB(.04)=1:0,1:$S(IB(.05)=1:2,IB(.05)=2:1,1:3))
S IB(.05,"OUT")=$S(IB(.04)=2:0,1:$S(IB(.05)=1:2,IB(.05)=2:1,1:3))
S IB(1)=$S(IB(.11)=0:"I $$MULTYP^IBCEF5(.IB,"_IB(.05,"IN")_","_IB(.05,"OUT")_")",IB(.11)=1:"I $$BILLTYP^IBCEF5(IBIFN,$G(IBDA))",IB(.11)=2:"I $$REQMRA^IBEFUNC(IBIFN)",1:"")
S DR=".03////"_IB(.03)_";.05////"_IB(.05)_";.02;.06;.08;4;.07"_$S(IB(.11)'=2:"",1:"////1")_";.11////"_IB(.11)
S DR=DR_";1"_$S(IB(.11)<9:"////"_IB(1),1:"")
S DIE="^IBE(364.4,",DA=IBDA1
D ^DIE
I $D(Y) S IBOK=0 G ADDQ
;
W !
S IB(.07)=$P($G(^IBE(364.4,IBDA1,0)),U,7)
;
D:IB(.07)'=3 INSCO^IBCEF51(.IB,.IBOK,IBDA1)
I 'IBOK K IB G ADDQ
I IB(.11)=1 D BTYP^IBCEF51(.IB,.IBOK) ;Enter applicable bill types
I 'IBOK K IB G ADDQ
;
I IBOK D ADDBTYP^IBCEF61(.IB,IBDA1),INSADD^IBCEF61(.IB,IBDA1)
;
ADDQ I $G(IBDA1),'IBOK S DA=IBDA1,DIK="^IBE(364.4," D ^DIK
I IBOK D REBLD^IBCEF6($G(IBACTIVE))
Q $S(IBOK:IBDA1,1:0)
;
BILLTYP(IBIFN,IBDA) ; Check bill type for valid to transmit
N IB,IB0,IB00,IB399,IBOK,IBALL,IBB,IBEXC,IBQUIT,IBINC,Z,Z1
S Z=$$FT^IBCEF(IBIFN)
S IB399=$G(^DGCR(399,IBIFN,0))
S IB0=$P(IB399,U,24,26)
S IB0=$P(IB0,U)_$P($G(^DGCR(399.1,+$P(IB0,U,2),0)),U,2)_$P(IB0,U,3)
;
S (IB,IBINC,IBOK,IBALL)=0
;
; Check for all bill types allowed, dates allowed
F S IB=$O(^IBE(364.4,IBDA,"BTYP","B","XXX",IB)) Q:'IB D Q:IBALL
. S IB00=$G(^IBE(364.4,IBDA,"BTYP",IB,0))
. I $S($P(IB00,U,2):$P(IB00,U,2)'>DT,1:1),$S($P(IB00,U,3):$P(IB00,U,3)>DT,1:1) S IBALL=1 Q
;
; If not all bill types are included, find out if any are included
I 'IBALL S IB="",IBINC=0 F S IB=$O(^IBE(364.4,IBDA,"BTYP","B",IB),-1) Q:IB=""!($E(IB)="-") D Q:IBINC
. S IBB=+$O(^IBE(364.4,IBDA,"BTYP","B",IB,0)),IB00=$G(^IBE(364.4,IBDA,"BTYP",IBB,0))
. I $S($P(IB00,U,2):$P(IB00,U,2)'>DT,1:1),$S($P(IB00,U,3):$P(IB00,U,3)>DT,1:1) S IBINC=1 Q
;
I IB0'="" D ;Check bill's type of bill in included list, or is excluded
. S (IBQUIT,IBEXC)=0
. F Z1=1,2 Q:Z1=2&'IBOK S:'IBINC Z1=2,IBOK=1 F IB=$E(IB0)_"XX",$E(IB0,1,2)_"X",IB0 S IBQUIT=0 D Q:IBQUIT
.. I Z1=2 S IB="-"_IB ;Checking for exclusions on this pass
.. S Z=0
.. F S Z=$O(^IBE(364.4,+$G(IBDA),"BTYP","B",IB,Z)) Q:'Z S IB00=$G(^IBE(364.4,IBDA,"BTYP",Z,0)),IBQUIT=0 D Q:IBQUIT
... I $P(IB00,U,2)>DT Q ;Not effective yet
... I $P(IB00,U,3),$P(IB00,U,3)'>DT Q ;Expired
... I $E(IB00)'="-" S (IBQUIT,IBOK)=1 Q ; Bill type included
... I $E(IB00)="-" S IBOK=0,(IBEXC,IBQUIT)=1 Q ; Bill type is excluded
. I 'IBALL,'IBINC,'IBEXC S IBOK=1 ;No active restrictions found
;
BTYPQ Q IBOK
;
QUIT ; DIR call to continue processing after error message display
S DIR("A")="Press RETURN to continue: "
S DIR(0)="EA" D ^DIR K DIR
;
Q
;
MULTYP(IB,IN,OUT) ; Code to execute to determine multiple types
; of I/O and prof/inst bills combinations OK to transmit
; IB = ien of bill in file 399
; IB(x) = array containing necessary data for xref search from bill
; subscripted by x=field # in file 364.4
; IN =0 or null for no inpt at all
; =1 for inpt,prof only; =2 for inpt,inst only; =3 for inpt,both
; OUT =0 or null for no outpt at all
; =1 for outpt,prof only; =2 for outpt,inst only; =3 for outpt,both
;
; Function returns 1 if edit passes, 0 if edit fails
;
; Functionality has been removed, but code remains in case they decide
; they need it later (INPT/OUTPT part)
;
N IBOK
S IBOK=1
; IB(.04) = the value of the bill's type of care (1=outpt, 2=inpt)
; IB(.05) = the value of the bill's form type (1=inst, 2=prof)
; outpatient bill
I $G(IB(.04))=1,$G(OUT)'=3 D G:'IBOK MULTQ
. I +$G(OUT)=0 S IBOK=0 Q
. I $G(OUT)=1,$G(IB(.05))'=2 S IBOK=0 Q
. I $G(OUT)=2,$G(IB(.05))'=1 S IBOK=0 Q
; inpatient bill
I $G(IB(.04))=2,$G(IN)'=3 D G:'IBOK MULTQ
. I +$G(IN)=0 S IBOK=0 Q
. I $G(IN)=1,$G(IB(.05))'=2 S IBOK=0 Q
. I $G(IN)=2,$G(IB(.05))'=1 S IBOK=0 Q
MULTQ Q IBOK
;
INSINC(IBD) ; Insurance include/exclude condition explanation
; IBD = line counter - pass by reference
S IBD=IBD+1,DIR("A",IBD)=""
S IBD=IBD+1,DIR("A",IBD)="THE EFFECT OF THIS RULE WILL BE: IF A BILL MATCHES BOTH OF THE ABOVE CONDITIONS,"
S IBD=IBD+1,DIR("A",IBD)="THE RULE WILL BE APPLIED AND THE BILL WILL NOT BE TRANSMITTED IF:"
S IBD=IBD+1,DIR("A",IBD)=" - THE RULE APPLIES TO ALL INSURANCE COMPANIES"
S IBD=IBD+1,DIR("A",IBD)=$J("",17)_"OR"
S IBD=IBD+1,DIR("A",IBD)=" - THE RULE 'APPLIES TO' ONLY SPECIFIC INSURANCE COMPANIES AND THE BILL'S"
S IBD=IBD+1,DIR("A",IBD)=" INSURANCE COMPANY APPEARS ON THE RULE'S 'INCLUDE LIST'"
S IBD=IBD+1,DIR("A",IBD)=$J("",17)_"OR"
S IBD=IBD+1,DIR("A",IBD)=" - THE RULE 'EXCLUDES' SPECIFIC INSURANCE COMPANIES AND THE BILL'S"
S IBD=IBD+1,DIR("A",IBD)=" INSURANCE COMPANY DOES NOT APPEAR ON THE RULE'S 'EXCLUDE LIST'"
Q
;
RTINC(IBD) ; Bill type include/exclude condition explanation
; IBD = line counter - pass by reference
;
S IBD=IBD+1,DIR("A",IBD)="*** AND ***"
S IBD=IBD+1,DIR("A",IBD)=" - THE RULE HAS NO BILL TYPE RESTRICTIONS OR APPLIES TO ALL BILL TYPES"
S IBD=IBD+1,DIR("A",IBD)=$J("",17)_"OR"
S IBD=IBD+1,DIR("A",IBD)=" - THE RULE IS RESTRICTED TO CERTAIN BILL TYPES AND THE BILL'S BILL TYPE IS"
S IBD=IBD+1,DIR("A",IBD)=" INCLUDED FOR THE RULE OR IS NOT EXCLUDED FOR THE RULE"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF5 9303 printed Dec 13, 2024@02:10:05 Page 2
IBCEF5 ;ALB/TMP - MRA/EDI ACTIVATED UTILITIES ;06-FEB-96
+1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
+2 ;
ADDRULE() ; Add a new rule to the EDI transmission rules file
+1 ; Function returns the entry number of the new rule or
+2 ; 0 if no rule added
+3 ;
+4 NEW DIR,X,Y,IBD,IBS,IBOK,IBDA1,IBC,DIC,DA,DR,DIE,IB,DO,DD,DLAYGO
+5 ;
+6 DO FULL^VALM1
+7 SET IBOK=1
+8 ;
+9 LOCK +^IBE(364.4,0):10
+10 IF '$TEST
SET IBOK=0
WRITE !,"FILE LOCKED ... TRY AGAIN LATER"
SET IBOK=0
GOTO ADDQ
+11 SET X=$ORDER(^IBE(364.4,"A"),-1)
+12 FOR
SET X=X+1
IF '$DATA(^IBE(364.4,X,0))
SET DIC="^IBE(364.4,"
SET DIC(0)="L"
SET DLAYGO=364.4
SET DIC("DR")="10.01////"_DUZ_";10.02///"_$$NOW^XLFDT
DO FILE^DICN
SET IBDA1=+Y
KILL DLAYGO,DIC
QUIT
+13 LOCK -^IBE(364.4,0)
+14 IF IBDA1'>0
SET IBOK=0
GOTO ADDQ
+15 KILL DIR
+16 SET DIR(0)="364.4,.11A"
SET DIR("A")="New Rule's TYPE OF RULE: "
+17 DO ^DIR
KILL DIR
+18 ;Required
IF $DATA(DIRUT)
SET IBOK=0
GOTO ADDQ
+19 SET IB(.11)=+Y
+20 IF +Y=0
WRITE !,"YOU ARE ADDING A RULE THAT WILL ONLY ALLOW THE TRANSMISSION OF BILLS WHOSE",!," FORM TYPE IS INCLUDED IN THIS RULE."
+21 ;
+22 ;MRA ONLY
SET IB(.03)=2
+23 IF IB(.11)'=2
Begin DoDot:1
+24 SET DIR(0)="364.4,.03A^^I X=2 K X"
SET DIR("A")="New Rule's TRANSMISSION TYPE: "
+25 DO ^DIR
KILL DIR,DA
+26 ;Required
IF Y'>0
SET IBOK=0
KILL IB(.03)
+27 SET IB(.03)=+Y
End DoDot:1
if 'IBOK
GOTO ADDQ
+28 ;
+29 SET DIR("A")=$SELECT(IB(.11)'=0:"APPLY RULE ONLY TO BILLS THAT ARE (I)NSTITUTIONAL, (P)ROFESSIONAL, OR (B)OTH: ",1:"ONLY TRANSMIT (I)NSTITUTIONAL, (P)ROFESSIONAL, OR (B)OTH: ")
+30 SET DIR(0)="SAM^I:INSTITUTIONAL ONLY;P:PROFESSIONAL ONLY;B:BOTH TYPES"
+31 DO ^DIR
KILL DIR,DA
+32 IF "IPB"'[Y
SET IBOK=0
GOTO ADDQ
+33 SET IB(.05)=$SELECT(Y="I":1,Y="P":2,1:3)
+34 ;
+35 ;S DIR("A")="APPLY RULE ONLY TO BILLS THAT ARE (I)NPATIENT, (O)UTPATIENT, OR (B)OTH: "
+36 ;S DIR(0)="SAM^I:INPATIENT;OUTPATIENT;B:BOTH"
+37 ;D ^DIR K DIR,DA
+38 ;I "IPB"'[Y S IBOK=0 G ADDQ
+39 ;S IB(.04)=$S(Y="I":1,Y="P":2,1:3)
+40 SET IB(.04)=3
+41 ;
+42 WRITE !
+43 ;
+44 SET IBS=""
SET $PIECE(IBS,"*",36)=""
+45 SET DIR("A",1)=IBS
+46 SET DIR("A",2)="THIS RULE WILL ONLY APPLY TO BILLS THAT MATCH ALL OF THE FOLLOWING CONDITIONS:"
+47 SET IBD=2
+48 IF IB(.11)'=2
Begin DoDot:1
+49 SET IBD=IBD+1
+50 SET DIR("A",IBD)=$JUSTIFY("",5)_"BILL IS "_$SELECT(IB(.03)<3:"AN "_$PIECE("EDI^MRA",U,+IB(.03)),1:"EITHER AN EDI OR MRA")_" BILL AND IS ALSO "
+51 SET Z=$SELECT(IB(.11)=0:IB(.05)#2+1,1:+IB(.05))
+52 SET DIR("A",IBD)=DIR("A",IBD)_$SELECT(IB(.05)<3:$PIECE("AN INSTITUTIONAL^A PROFESSIONAL",U,Z),1:"EITHER A PROFESSIONAL OR INSTITUTIONAL")_" BILL"
+53 ;S IBD=IBD+1,DIR("A",IBD)=$J("",5)_"AND "_$S(IB(.04)<3:"IS ALSO AN "_$P("INPATIENT^OUTPATIENT",U,+IB(.04)),1:"IS EITHER AN INPATIENT OR OUTPATIENT")_" BILL."
+54 SET IBD=IBD+1
SET DIR("A",IBD)=""
+55 SET IBD=IBD+1
SET DIR("A",IBD)="NOTE: RULE WILL BE IGNORED FOR ANY BILLS THAT DO NOT MATCH ALL THE CONDITIONS"
+56 ;
+57 IF IB(.11)=0
DO INSINC(.IBD)
+58 ;
+59 IF IB(.11)=1
Begin DoDot:2
+60 DO INSINC(.IBD)
DO RTINC(.IBD)
End DoDot:2
+61 ;
+62 IF IB(.11)=9
Begin DoDot:2
+63 SET IBD=IBD+1
SET DIR("A",IBD)=""
+64 DO INSINC(.IBD)
End DoDot:2
End DoDot:1
+65 ;
+66 IF IB(.11)=2
Begin DoDot:1
+67 SET IBD=IBD+1
SET DIR("A",IBD)=$JUSTIFY("",5)_"BILL IS AN MRA BILL"
+68 SET IBD=IBD+1
SET DIR("A",IBD)=$JUSTIFY("",5)_"AND IS ALSO "_$SELECT(IB(.05)<3:$PIECE("AN INSTITUTIONAL^A PROFESSIONAL",U,+IB(.05)),1:"EITHER A PROFESSIONAL OR INSTITUTIONAL")_" BILL"
+69 ;S IBD=IBD+1,DIR("A",IBD)=$J("",7)_"AND "_$S(IB(.04)<3:"IS ALSO AN "_$P("INPATIENT^OUTPATIENT",U,+IB(.04)),1:"IS EITHER AN INPATIENT OR OUTPATIENT")_" BILL"
+70 SET IBD=IBD+1
SET DIR("A",IBD)=$JUSTIFY("",5)_"AND ALSO HAS A NEXT INSURANCE THAT HAS BEEN INCLUDED IN THE"
+71 SET IBD=IBD+1
SET DIR("A",IBD)=$JUSTIFY("",8)_"'INSURANCE COMPANIES INCLUDED' LIST FOR THIS RULE."
+72 SET IBD=IBD+1
SET DIR("A",IBD)=""
+73 SET IBD=IBD+1
SET DIR("A",IBD)="NOTE: THIS RULE WILL BE IGNORED FOR ANY BILL THAT DOES NOT MATCH"
+74 SET IBD=IBD+1
SET DIR("A",IBD)=" ALL OF THESE CONDITIONS."
+75 SET IBD=IBD+1
SET DIR("A",IBD)=""
+76 SET IBD=IBD+1
SET DIR("A",IBD)="THE EFFECT OF THIS RULE WILL BE: IF A BILL MATCHES ALL OF THE ABOVE CONDITIONS,"
+77 SET IBD=IBD+1
SET DIR("A",IBD)="THE REQUEST AND RECEIPT OF AN MRA WILL NOT BE ALLOWED."
End DoDot:1
+78 SET IBD=IBD+1
SET DIR("A",IBD)=IBS
+79 ;
+80 SET DIR("A")="IS THIS CORRECT? "
+81 SET DIR(0)="YA"
SET DIR("B")="YES"
+82 DO ^DIR
KILL DIR
+83 IF 'Y
SET IBOK=0
GOTO ADDQ
+84 ;
+85 WRITE !
+86 ;
+87 ; Combine inpatient/outpatient and inst/prof checks
+88 SET IB(.05,"IN")=$SELECT(IB(.04)=1:0,1:$SELECT(IB(.05)=1:2,IB(.05)=2:1,1:3))
+89 SET IB(.05,"OUT")=$SELECT(IB(.04)=2:0,1:$SELECT(IB(.05)=1:2,IB(.05)=2:1,1:3))
+90 SET IB(1)=$SELECT(IB(.11)=0:"I $$MULTYP^IBCEF5(.IB,"_IB(.05,"IN")_","_IB(.05,"OUT")_")",IB(.11)=1:"I $$BILLTYP^IBCEF5(IBIFN,$G(IBDA))",IB(.11)=2:"I $$REQMRA^IBEFUNC(IBIFN)",1:"")
+91 SET DR=".03////"_IB(.03)_";.05////"_IB(.05)_";.02;.06;.08;4;.07"_$SELECT(IB(.11)'=2:"",1:"////1")_";.11////"_IB(.11)
+92 SET DR=DR_";1"_$SELECT(IB(.11)<9:"////"_IB(1),1:"")
+93 SET DIE="^IBE(364.4,"
SET DA=IBDA1
+94 DO ^DIE
+95 IF $DATA(Y)
SET IBOK=0
GOTO ADDQ
+96 ;
+97 WRITE !
+98 SET IB(.07)=$PIECE($GET(^IBE(364.4,IBDA1,0)),U,7)
+99 ;
+100 if IB(.07)'=3
DO INSCO^IBCEF51(.IB,.IBOK,IBDA1)
+101 IF 'IBOK
KILL IB
GOTO ADDQ
+102 ;Enter applicable bill types
IF IB(.11)=1
DO BTYP^IBCEF51(.IB,.IBOK)
+103 IF 'IBOK
KILL IB
GOTO ADDQ
+104 ;
+105 IF IBOK
DO ADDBTYP^IBCEF61(.IB,IBDA1)
DO INSADD^IBCEF61(.IB,IBDA1)
+106 ;
ADDQ IF $GET(IBDA1)
IF 'IBOK
SET DA=IBDA1
SET DIK="^IBE(364.4,"
DO ^DIK
+1 IF IBOK
DO REBLD^IBCEF6($GET(IBACTIVE))
+2 QUIT $SELECT(IBOK:IBDA1,1:0)
+3 ;
BILLTYP(IBIFN,IBDA) ; Check bill type for valid to transmit
+1 NEW IB,IB0,IB00,IB399,IBOK,IBALL,IBB,IBEXC,IBQUIT,IBINC,Z,Z1
+2 SET Z=$$FT^IBCEF(IBIFN)
+3 SET IB399=$GET(^DGCR(399,IBIFN,0))
+4 SET IB0=$PIECE(IB399,U,24,26)
+5 SET IB0=$PIECE(IB0,U)_$PIECE($GET(^DGCR(399.1,+$PIECE(IB0,U,2),0)),U,2)_$PIECE(IB0,U,3)
+6 ;
+7 SET (IB,IBINC,IBOK,IBALL)=0
+8 ;
+9 ; Check for all bill types allowed, dates allowed
+10 FOR
SET IB=$ORDER(^IBE(364.4,IBDA,"BTYP","B","XXX",IB))
if 'IB
QUIT
Begin DoDot:1
+11 SET IB00=$GET(^IBE(364.4,IBDA,"BTYP",IB,0))
+12 IF $SELECT($PIECE(IB00,U,2):$PIECE(IB00,U,2)'>DT,1:1)
IF $SELECT($PIECE(IB00,U,3):$PIECE(IB00,U,3)>DT,1:1)
SET IBALL=1
QUIT
End DoDot:1
if IBALL
QUIT
+13 ;
+14 ; If not all bill types are included, find out if any are included
+15 IF 'IBALL
SET IB=""
SET IBINC=0
FOR
SET IB=$ORDER(^IBE(364.4,IBDA,"BTYP","B",IB),-1)
if IB=""!($EXTRACT(IB)="-")
QUIT
Begin DoDot:1
+16 SET IBB=+$ORDER(^IBE(364.4,IBDA,"BTYP","B",IB,0))
SET IB00=$GET(^IBE(364.4,IBDA,"BTYP",IBB,0))
+17 IF $SELECT($PIECE(IB00,U,2):$PIECE(IB00,U,2)'>DT,1:1)
IF $SELECT($PIECE(IB00,U,3):$PIECE(IB00,U,3)>DT,1:1)
SET IBINC=1
QUIT
End DoDot:1
if IBINC
QUIT
+18 ;
+19 ;Check bill's type of bill in included list, or is excluded
IF IB0'=""
Begin DoDot:1
+20 SET (IBQUIT,IBEXC)=0
+21 FOR Z1=1,2
if Z1=2&'IBOK
QUIT
if 'IBINC
SET Z1=2
SET IBOK=1
FOR IB=$EXTRACT(IB0)_"XX",$EXTRACT(IB0,1,2)_"X",IB0
SET IBQUIT=0
Begin DoDot:2
+22 ;Checking for exclusions on this pass
IF Z1=2
SET IB="-"_IB
+23 SET Z=0
+24 FOR
SET Z=$ORDER(^IBE(364.4,+$GET(IBDA),"BTYP","B",IB,Z))
if 'Z
QUIT
SET IB00=$GET(^IBE(364.4,IBDA,"BTYP",Z,0))
SET IBQUIT=0
Begin DoDot:3
+25 ;Not effective yet
IF $PIECE(IB00,U,2)>DT
QUIT
+26 ;Expired
IF $PIECE(IB00,U,3)
IF $PIECE(IB00,U,3)'>DT
QUIT
+27 ; Bill type included
IF $EXTRACT(IB00)'="-"
SET (IBQUIT,IBOK)=1
QUIT
+28 ; Bill type is excluded
IF $EXTRACT(IB00)="-"
SET IBOK=0
SET (IBEXC,IBQUIT)=1
QUIT
End DoDot:3
if IBQUIT
QUIT
End DoDot:2
if IBQUIT
QUIT
+29 ;No active restrictions found
IF 'IBALL
IF 'IBINC
IF 'IBEXC
SET IBOK=1
End DoDot:1
+30 ;
BTYPQ QUIT IBOK
+1 ;
QUIT ; DIR call to continue processing after error message display
+1 SET DIR("A")="Press RETURN to continue: "
+2 SET DIR(0)="EA"
DO ^DIR
KILL DIR
+3 ;
+4 QUIT
+5 ;
MULTYP(IB,IN,OUT) ; Code to execute to determine multiple types
+1 ; of I/O and prof/inst bills combinations OK to transmit
+2 ; IB = ien of bill in file 399
+3 ; IB(x) = array containing necessary data for xref search from bill
+4 ; subscripted by x=field # in file 364.4
+5 ; IN =0 or null for no inpt at all
+6 ; =1 for inpt,prof only; =2 for inpt,inst only; =3 for inpt,both
+7 ; OUT =0 or null for no outpt at all
+8 ; =1 for outpt,prof only; =2 for outpt,inst only; =3 for outpt,both
+9 ;
+10 ; Function returns 1 if edit passes, 0 if edit fails
+11 ;
+12 ; Functionality has been removed, but code remains in case they decide
+13 ; they need it later (INPT/OUTPT part)
+14 ;
+15 NEW IBOK
+16 SET IBOK=1
+17 ; IB(.04) = the value of the bill's type of care (1=outpt, 2=inpt)
+18 ; IB(.05) = the value of the bill's form type (1=inst, 2=prof)
+19 ; outpatient bill
+20 IF $GET(IB(.04))=1
IF $GET(OUT)'=3
Begin DoDot:1
+21 IF +$GET(OUT)=0
SET IBOK=0
QUIT
+22 IF $GET(OUT)=1
IF $GET(IB(.05))'=2
SET IBOK=0
QUIT
+23 IF $GET(OUT)=2
IF $GET(IB(.05))'=1
SET IBOK=0
QUIT
End DoDot:1
if 'IBOK
GOTO MULTQ
+24 ; inpatient bill
+25 IF $GET(IB(.04))=2
IF $GET(IN)'=3
Begin DoDot:1
+26 IF +$GET(IN)=0
SET IBOK=0
QUIT
+27 IF $GET(IN)=1
IF $GET(IB(.05))'=2
SET IBOK=0
QUIT
+28 IF $GET(IN)=2
IF $GET(IB(.05))'=1
SET IBOK=0
QUIT
End DoDot:1
if 'IBOK
GOTO MULTQ
MULTQ QUIT IBOK
+1 ;
INSINC(IBD) ; Insurance include/exclude condition explanation
+1 ; IBD = line counter - pass by reference
+2 SET IBD=IBD+1
SET DIR("A",IBD)=""
+3 SET IBD=IBD+1
SET DIR("A",IBD)="THE EFFECT OF THIS RULE WILL BE: IF A BILL MATCHES BOTH OF THE ABOVE CONDITIONS,"
+4 SET IBD=IBD+1
SET DIR("A",IBD)="THE RULE WILL BE APPLIED AND THE BILL WILL NOT BE TRANSMITTED IF:"
+5 SET IBD=IBD+1
SET DIR("A",IBD)=" - THE RULE APPLIES TO ALL INSURANCE COMPANIES"
+6 SET IBD=IBD+1
SET DIR("A",IBD)=$JUSTIFY("",17)_"OR"
+7 SET IBD=IBD+1
SET DIR("A",IBD)=" - THE RULE 'APPLIES TO' ONLY SPECIFIC INSURANCE COMPANIES AND THE BILL'S"
+8 SET IBD=IBD+1
SET DIR("A",IBD)=" INSURANCE COMPANY APPEARS ON THE RULE'S 'INCLUDE LIST'"
+9 SET IBD=IBD+1
SET DIR("A",IBD)=$JUSTIFY("",17)_"OR"
+10 SET IBD=IBD+1
SET DIR("A",IBD)=" - THE RULE 'EXCLUDES' SPECIFIC INSURANCE COMPANIES AND THE BILL'S"
+11 SET IBD=IBD+1
SET DIR("A",IBD)=" INSURANCE COMPANY DOES NOT APPEAR ON THE RULE'S 'EXCLUDE LIST'"
+12 QUIT
+13 ;
RTINC(IBD) ; Bill type include/exclude condition explanation
+1 ; IBD = line counter - pass by reference
+2 ;
+3 SET IBD=IBD+1
SET DIR("A",IBD)="*** AND ***"
+4 SET IBD=IBD+1
SET DIR("A",IBD)=" - THE RULE HAS NO BILL TYPE RESTRICTIONS OR APPLIES TO ALL BILL TYPES"
+5 SET IBD=IBD+1
SET DIR("A",IBD)=$JUSTIFY("",17)_"OR"
+6 SET IBD=IBD+1
SET DIR("A",IBD)=" - THE RULE IS RESTRICTED TO CERTAIN BILL TYPES AND THE BILL'S BILL TYPE IS"
+7 SET IBD=IBD+1
SET DIR("A",IBD)=" INCLUDED FOR THE RULE OR IS NOT EXCLUDED FOR THE RULE"
+8 QUIT
+9 ;
