IBJPS4 ;BP/YMG - IB Site Parameters, Pay-To Provider Associations ;06-Nov-2008
;;2.0;INTEGRATED BILLING;**400,516,608**;21-MAR-94;Build 90
;;Per VA Directive 6402, this routine should not be modified.
;
; MRD;IB*2.0*516 - Added logic pertaining to TRICARE-Specific Pay-To
; Providers, which entailed adding the parameter IBTCFLAG to many
; procedures here and in ^IBJPS3.
;
EN(IBTCFLAG) ; -- main entry point for IBJP IB PAY-TO ASSOCIATIONS
; select pay-to provider
D EN^VALM("IBJP IB "_$S(IBTCFLAG:"TRICARE PAY-TO ASSOCS",1:"PAY-TO ASSOCIATIONS"))
S VALMBCK="R"
Q
;
HDR ; -- header code
S VALMHDR(1)=""
Q
;
INIT(IBTCFLAG) ; -- init variables and list array
N DFLT,HASDIVS,IBCNT,IBLN,IBSTR,IEN4,PIEN,PROVS
S DFLT=$$GETDFLT^IBJPS3(IBTCFLAG) D BLD(DFLT,.PROVS,IBTCFLAG)
I $D(PROVS) D
.; create listman array
.S (IBCNT,IBLN)=0 S PIEN="" F S PIEN=$O(PROVS(PIEN)) Q:PIEN="" D
..S IBLN=IBLN+1
..S IBSTR=$$SETSTR^VALM1(PROVS(PIEN)_$S($$ISDFLT^IBJPS3(PIEN,IBTCFLAG):" (Default)",1:""),"",2,75)
..D SET^VALM10(IBLN,IBSTR)
..S HASDIVS=0,IEN4="" F S IEN4=$O(PROVS(PIEN,IEN4)) Q:IEN4="" D
...S IBLN=IBLN+1,IBCNT=IBCNT+1 S:'HASDIVS HASDIVS=1
...S IBSTR=$$SETSTR^VALM1(IBCNT,"",8,4)
...S IBSTR=$$SETSTR^VALM1($P(PROVS(PIEN,IEN4),U,2),IBSTR,14,8)
...S IBSTR=$$SETSTR^VALM1($P(PROVS(PIEN,IEN4),U),IBSTR,24,55)
...D SET^VALM10(IBLN,IBSTR)
...S @VALMAR@("ZIDX",IBCNT,IEN4)=""
...Q
..I 'HASDIVS S IBSTR=$$SETSTR^VALM1("No Divisions found.","",8,45) S IBLN=IBLN+1 D SET^VALM10(IBLN,IBSTR)
..S IBLN=IBLN+1 D SET^VALM10(IBLN,"")
..Q
.Q
I 'DFLT S IBLN=$$SET^IBJPS3(0,$$SETSTR^VALM1("No Default "_$S(IBTCFLAG:"Non-MCCF ",1:"")_"Pay-To Provider found.","",11,42))
I DFLT,'$D(PROVS) S IBLN=$$SET^IBJPS3(0,$$SETSTR^VALM1("No "_$S(IBTCFLAG:"Non-MCCF ",1:"")_"Pay-To Providers found.","",15,35))
S VALMCNT=IBLN,VALMBG=1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAR^VALM1,CLEAN^VALM10
Q
;
BLD(DFLT,PROVS,IBTCFLAG) ; build array of pay-to providers and divisions
N ALLDIVS,DIEN,DIVDATA,I,IB0,IEN4,PIEN,IBNODE
I DFLT'>0 Q
S IBNODE=$$NODE(IBTCFLAG)
;
; create list of all pay-to providers
S I=0 F S I=$O(^IBE(350.9,1,IBNODE,I)) Q:'I D
.S IB0=$G(^IBE(350.9,1,IBNODE,I,0)) I 'IB0 Q
.I $P(IB0,U,5)="" S PROVS(I)=$P(IB0,U,2)
.Q
I $D(PROVS) D
.; add divisions to the list
.D LIST^DIC(40.8,,"@;.01;.07I","PQ",,,,,,,"ALLDIVS")
.I $D(ALLDIVS) S I=0 F S I=$O(ALLDIVS("DILIST",I)) Q:I="" D
..; make sure that we have a file 4 ien to work with
..S DIVDATA=$G(ALLDIVS("DILIST",I,0)),IEN4=$P(DIVDATA,U,3) I IEN4="" Q
..S DIEN=$O(^IBE(350.9,1,IBNODE,"B",IEN4,""))
..; if there is an entry in 350.9 for this division, get corresponding pay-to provider
..; otherwise, use default pay-to provider
..S PIEN=$S(DIEN:$$GETPROV(DIEN,IBTCFLAG),1:DFLT)
..; add this division to the list as division name ^ station number
..S PROVS(PIEN,IEN4)=$P(DIVDATA,U,2)_U_$$GET1^DIQ(4,IEN4,99)
..Q
.Q
D CLEAN^DILF
Q
;
SEL() ; select division
; returns ien of selected division, or 0 if nothing is selected
N DIR,IEN,MAX,X,Y
S IEN=0,MAX=+$O(@VALMAR@("ZIDX",""),-1)
I MAX>0 D
.S:MAX=1 Y=1 I MAX>1 S DIR("A")="Select Division (1-"_MAX_"): ",DIR(0)="NA^"_1_":"_MAX_":0" D ^DIR
.S:+Y>0 IEN=$O(@VALMAR@("ZIDX",Y,""))
.Q
Q +IEN
;
DIVADD(IBTCFLAG) ; associate division with a pay-to provider
N DA,DFLT,DIC,DIE,DIEN,DIR,DNAME,DR,IEN4,IEN19,Y,IBNODE
S IBNODE=$$NODE(IBTCFLAG)
;
D FULL^VALM1
S VALMBCK="R"
S IEN4=$$SEL I IEN4>0 D
.S IEN19=$O(^IBE(350.9,1,IBNODE,"B",IEN4,"")) I IEN19="" D
..; create a new entry in 350.9
..S DIEN=$$FIND1^DIC(40.8,,"QX",IEN4,"AD") I 'DIEN Q
..S DNAME=$$GET1^DIQ(40.8,DIEN,.01),DFLT=$$GETDFLT^IBJPS3(IBTCFLAG) I 'DFLT Q
..I IEN4=+$G(^IBE(350.9,1,IBNODE,DFLT,0)) D ERR Q
..S DIC="^IBE(350.9,1,"_IBNODE_",",DIC(0)="L",DIC("DR")=".02////"_DNAME_";.05////"_DFLT,X=IEN4,DLAYGO=350.9,DA(1)=1
..K DD,DO D FILE^DICN I +Y>0 S IEN19=+Y
..K DIC,DD,DO,DLAYGO
..Q
.I +IEN19>0 D
..I $P($G(^IBE(350.9,1,IBNODE,IEN19,0)),U,5)="" D ERR Q
..S DIR(0)="P^IBE(350.9,1,"_IBNODE_",:M",DIR("S")="I $P(^(0),U,5)="""""
..S DA(1)=1,DIR("A")="Select "_$S(IBTCFLAG:"Non-MCCF ",1:"")_"Pay-To Provider"
..D ^DIR
..I +Y>0 S DIE="^IBE(350.9,1,"_IBNODE_",",DA=IEN19,DA(1)=1,DR=".05////"_+Y D ^DIE
.Q
D CLEAN^VALM10,CLEAN^DILF,INIT(IBTCFLAG)
Q
;
ERR ;
N DIR
S DIR("A",1)="A division used as a Pay-to Provider cannot be associated"
S DIR("A",2)="with another Pay-to Provider."
S DIR("A")="Press RETURN to continue: "
S DIR(0)="EA" D ^DIR
Q
;
GETPROV(PIEN,IBTCFLAG) ; return pay-to provider ien for a given division, or 0 if provider can't be found
; PIEN has to be a valid ien in pay-to providers sub-file
;
N PRVZ,NXTPIEN,OUT,IBNODE
S PRVZ(PIEN)="" ; this array holds ien's to prevent infinite chain
S IBNODE=$$NODE(IBTCFLAG)
S OUT=0 F S NXTPIEN=+$P($G(^IBE(350.9,1,IBNODE,PIEN,0)),U,5) D Q:OUT ;
.I 'NXTPIEN S OUT=1 Q ; no parent - this is pay-to provider
.I $D(PRVZ(NXTPIEN)) S PIEN=0,OUT=1 Q ; we are in an infinite loop, so get out
.S PIEN=NXTPIEN,PRVZ(NXTPIEN)="" ; parent exists, so continue the loop
.Q
Q PIEN
;
GETDIVS(PIEN,DIVS,IBTCFLAG) ; return array of divisions associated with pay-to provider PIEN
N I,DIV,PPROV,IBNODE
S IBNODE=$$NODE(IBTCFLAG)
S I="" F S I=$O(^IBE(350.9,1,IBNODE,"B",I)) Q:I="" D
.S DIV=$O(^IBE(350.9,1,IBNODE,"B",I,""))
.Q:+DIV'>0 S PPROV=$$GETPROV(DIV,IBTCFLAG)
.I PPROV=PIEN,DIV'=PIEN S DIVS(DIV)=$P($G(^IBE(350.9,1,IBNODE,DIV,0)),U,2)
.Q
Q
;
NODE(IBTCFLAG) ; Determine appropriate pay-to provide node within ^IBE(350.9).
; '29' for TRICARE, otherwise '19'.
Q $S(IBTCFLAG:29,1:19)
;
SCRN4(IEN) ; Screen for INSTITUTION(#4) file
N DIERR,IENS,FIELDS,Z,ZERR
S IENS=+IEN_",",FIELDS="11;13;101"
D GETS^DIQ(4,IENS,FIELDS,"IE","Z","ZERR")
I $D(DIERR) Q 0
;Check to see if National
I Z(4,IENS,11,"I")'="N" Q 0
;Check to see if Inactive
I Z(4,IENS,101,"I") Q 0
;Check to see if Pharmacy
I "^PHARM^CMOP^MSN^"[(U_Z(4,IENS,13,"E")_U) Q 0
;Default
Q 1
;
TRICARE(IBIFN) ; Determine whether this bill/claim is TRICARE or not.
; Return '1' if TRICARE, '0' if not. There are two rate types that
; should return '1': TRICARE and TRICARE REIMB. INS.
;
; This has been modified to reflect Non-MCCF Claims and not just TRICARE. - IB*2.0*608 - vd (US2599)
;
I '$G(IBIFN) Q 0
N IBRATE
S IBRATE=$P(^DGCR(399,IBIFN,0),U,7)
I 'IBRATE Q 0
;
;/Begin IB*2.0*608 - vd (US2599) - Replaced the following lines
; I $P($G(^DGCR(399.3,IBRATE,0)),U)'["TRICARE" Q 0
I '$D(^IBE(350.9,1,28,"B",IBRATE)) Q 0 ; Not a Non-MCCF Pay-to Provider Rate Type.
;/End IB*2.0*608 - vd
;
; At this point, the claim has a Non-MCCF rate type However,
; quit with a '1' only if a default Non-MCCF-specific pay-to
; provider is defined. Otherwise, quit with a '0'.
;
I $$GETDFLT^IBJPS3(1) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPS4 7012 printed Oct 16, 2024@18:24:17 Page 2
IBJPS4 ;BP/YMG - IB Site Parameters, Pay-To Provider Associations ;06-Nov-2008
+1 ;;2.0;INTEGRATED BILLING;**400,516,608**;21-MAR-94;Build 90
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MRD;IB*2.0*516 - Added logic pertaining to TRICARE-Specific Pay-To
+5 ; Providers, which entailed adding the parameter IBTCFLAG to many
+6 ; procedures here and in ^IBJPS3.
+7 ;
EN(IBTCFLAG) ; -- main entry point for IBJP IB PAY-TO ASSOCIATIONS
+1 ; select pay-to provider
+2 DO EN^VALM("IBJP IB "_$SELECT(IBTCFLAG:"TRICARE PAY-TO ASSOCS",1:"PAY-TO ASSOCIATIONS"))
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
HDR ; -- header code
+1 SET VALMHDR(1)=""
+2 QUIT
+3 ;
INIT(IBTCFLAG) ; -- init variables and list array
+1 NEW DFLT,HASDIVS,IBCNT,IBLN,IBSTR,IEN4,PIEN,PROVS
+2 SET DFLT=$$GETDFLT^IBJPS3(IBTCFLAG)
DO BLD(DFLT,.PROVS,IBTCFLAG)
+3 IF $DATA(PROVS)
Begin DoDot:1
+4 ; create listman array
+5 SET (IBCNT,IBLN)=0
SET PIEN=""
FOR
SET PIEN=$ORDER(PROVS(PIEN))
if PIEN=""
QUIT
Begin DoDot:2
+6 SET IBLN=IBLN+1
+7 SET IBSTR=$$SETSTR^VALM1(PROVS(PIEN)_$SELECT($$ISDFLT^IBJPS3(PIEN,IBTCFLAG):" (Default)",1:""),"",2,75)
+8 DO SET^VALM10(IBLN,IBSTR)
+9 SET HASDIVS=0
SET IEN4=""
FOR
SET IEN4=$ORDER(PROVS(PIEN,IEN4))
if IEN4=""
QUIT
Begin DoDot:3
+10 SET IBLN=IBLN+1
SET IBCNT=IBCNT+1
if 'HASDIVS
SET HASDIVS=1
+11 SET IBSTR=$$SETSTR^VALM1(IBCNT,"",8,4)
+12 SET IBSTR=$$SETSTR^VALM1($PIECE(PROVS(PIEN,IEN4),U,2),IBSTR,14,8)
+13 SET IBSTR=$$SETSTR^VALM1($PIECE(PROVS(PIEN,IEN4),U),IBSTR,24,55)
+14 DO SET^VALM10(IBLN,IBSTR)
+15 SET @VALMAR@("ZIDX",IBCNT,IEN4)=""
+16 QUIT
End DoDot:3
+17 IF 'HASDIVS
SET IBSTR=$$SETSTR^VALM1("No Divisions found.","",8,45)
SET IBLN=IBLN+1
DO SET^VALM10(IBLN,IBSTR)
+18 SET IBLN=IBLN+1
DO SET^VALM10(IBLN,"")
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 IF 'DFLT
SET IBLN=$$SET^IBJPS3(0,$$SETSTR^VALM1("No Default "_$SELECT(IBTCFLAG:"Non-MCCF ",1:"")_"Pay-To Provider found.","",11,42))
+22 IF DFLT
IF '$DATA(PROVS)
SET IBLN=$$SET^IBJPS3(0,$$SETSTR^VALM1("No "_$SELECT(IBTCFLAG:"Non-MCCF ",1:"")_"Pay-To Providers found.","",15,35))
+23 SET VALMCNT=IBLN
SET VALMBG=1
+24 QUIT
+25 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAR^VALM1
DO CLEAN^VALM10
+2 QUIT
+3 ;
BLD(DFLT,PROVS,IBTCFLAG) ; build array of pay-to providers and divisions
+1 NEW ALLDIVS,DIEN,DIVDATA,I,IB0,IEN4,PIEN,IBNODE
+2 IF DFLT'>0
QUIT
+3 SET IBNODE=$$NODE(IBTCFLAG)
+4 ;
+5 ; create list of all pay-to providers
+6 SET I=0
FOR
SET I=$ORDER(^IBE(350.9,1,IBNODE,I))
if 'I
QUIT
Begin DoDot:1
+7 SET IB0=$GET(^IBE(350.9,1,IBNODE,I,0))
IF 'IB0
QUIT
+8 IF $PIECE(IB0,U,5)=""
SET PROVS(I)=$PIECE(IB0,U,2)
+9 QUIT
End DoDot:1
+10 IF $DATA(PROVS)
Begin DoDot:1
+11 ; add divisions to the list
+12 DO LIST^DIC(40.8,,"@;.01;.07I","PQ",,,,,,,"ALLDIVS")
+13 IF $DATA(ALLDIVS)
SET I=0
FOR
SET I=$ORDER(ALLDIVS("DILIST",I))
if I=""
QUIT
Begin DoDot:2
+14 ; make sure that we have a file 4 ien to work with
+15 SET DIVDATA=$GET(ALLDIVS("DILIST",I,0))
SET IEN4=$PIECE(DIVDATA,U,3)
IF IEN4=""
QUIT
+16 SET DIEN=$ORDER(^IBE(350.9,1,IBNODE,"B",IEN4,""))
+17 ; if there is an entry in 350.9 for this division, get corresponding pay-to provider
+18 ; otherwise, use default pay-to provider
+19 SET PIEN=$SELECT(DIEN:$$GETPROV(DIEN,IBTCFLAG),1:DFLT)
+20 ; add this division to the list as division name ^ station number
+21 SET PROVS(PIEN,IEN4)=$PIECE(DIVDATA,U,2)_U_$$GET1^DIQ(4,IEN4,99)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 DO CLEAN^DILF
+25 QUIT
+26 ;
SEL() ; select division
+1 ; returns ien of selected division, or 0 if nothing is selected
+2 NEW DIR,IEN,MAX,X,Y
+3 SET IEN=0
SET MAX=+$ORDER(@VALMAR@("ZIDX",""),-1)
+4 IF MAX>0
Begin DoDot:1
+5 if MAX=1
SET Y=1
IF MAX>1
SET DIR("A")="Select Division (1-"_MAX_"): "
SET DIR(0)="NA^"_1_":"_MAX_":0"
DO ^DIR
+6 if +Y>0
SET IEN=$ORDER(@VALMAR@("ZIDX",Y,""))
+7 QUIT
End DoDot:1
+8 QUIT +IEN
+9 ;
DIVADD(IBTCFLAG) ; associate division with a pay-to provider
+1 NEW DA,DFLT,DIC,DIE,DIEN,DIR,DNAME,DR,IEN4,IEN19,Y,IBNODE
+2 SET IBNODE=$$NODE(IBTCFLAG)
+3 ;
+4 DO FULL^VALM1
+5 SET VALMBCK="R"
+6 SET IEN4=$$SEL
IF IEN4>0
Begin DoDot:1
+7 SET IEN19=$ORDER(^IBE(350.9,1,IBNODE,"B",IEN4,""))
IF IEN19=""
Begin DoDot:2
+8 ; create a new entry in 350.9
+9 SET DIEN=$$FIND1^DIC(40.8,,"QX",IEN4,"AD")
IF 'DIEN
QUIT
+10 SET DNAME=$$GET1^DIQ(40.8,DIEN,.01)
SET DFLT=$$GETDFLT^IBJPS3(IBTCFLAG)
IF 'DFLT
QUIT
+11 IF IEN4=+$GET(^IBE(350.9,1,IBNODE,DFLT,0))
DO ERR
QUIT
+12 SET DIC="^IBE(350.9,1,"_IBNODE_","
SET DIC(0)="L"
SET DIC("DR")=".02////"_DNAME_";.05////"_DFLT
SET X=IEN4
SET DLAYGO=350.9
SET DA(1)=1
+13 KILL DD,DO
DO FILE^DICN
IF +Y>0
SET IEN19=+Y
+14 KILL DIC,DD,DO,DLAYGO
+15 QUIT
End DoDot:2
+16 IF +IEN19>0
Begin DoDot:2
+17 IF $PIECE($GET(^IBE(350.9,1,IBNODE,IEN19,0)),U,5)=""
DO ERR
QUIT
+18 SET DIR(0)="P^IBE(350.9,1,"_IBNODE_",:M"
SET DIR("S")="I $P(^(0),U,5)="""""
+19 SET DA(1)=1
SET DIR("A")="Select "_$SELECT(IBTCFLAG:"Non-MCCF ",1:"")_"Pay-To Provider"
+20 DO ^DIR
+21 IF +Y>0
SET DIE="^IBE(350.9,1,"_IBNODE_","
SET DA=IEN19
SET DA(1)=1
SET DR=".05////"_+Y
DO ^DIE
End DoDot:2
+22 QUIT
End DoDot:1
+23 DO CLEAN^VALM10
DO CLEAN^DILF
DO INIT(IBTCFLAG)
+24 QUIT
+25 ;
ERR ;
+1 NEW DIR
+2 SET DIR("A",1)="A division used as a Pay-to Provider cannot be associated"
+3 SET DIR("A",2)="with another Pay-to Provider."
+4 SET DIR("A")="Press RETURN to continue: "
+5 SET DIR(0)="EA"
DO ^DIR
+6 QUIT
+7 ;
GETPROV(PIEN,IBTCFLAG) ; return pay-to provider ien for a given division, or 0 if provider can't be found
+1 ; PIEN has to be a valid ien in pay-to providers sub-file
+2 ;
+3 NEW PRVZ,NXTPIEN,OUT,IBNODE
+4 ; this array holds ien's to prevent infinite chain
SET PRVZ(PIEN)=""
+5 SET IBNODE=$$NODE(IBTCFLAG)
+6 ;
SET OUT=0
FOR
SET NXTPIEN=+$PIECE($GET(^IBE(350.9,1,IBNODE,PIEN,0)),U,5)
Begin DoDot:1
+7 ; no parent - this is pay-to provider
IF 'NXTPIEN
SET OUT=1
QUIT
+8 ; we are in an infinite loop, so get out
IF $DATA(PRVZ(NXTPIEN))
SET PIEN=0
SET OUT=1
QUIT
+9 ; parent exists, so continue the loop
SET PIEN=NXTPIEN
SET PRVZ(NXTPIEN)=""
+10 QUIT
End DoDot:1
if OUT
QUIT
+11 QUIT PIEN
+12 ;
GETDIVS(PIEN,DIVS,IBTCFLAG) ; return array of divisions associated with pay-to provider PIEN
+1 NEW I,DIV,PPROV,IBNODE
+2 SET IBNODE=$$NODE(IBTCFLAG)
+3 SET I=""
FOR
SET I=$ORDER(^IBE(350.9,1,IBNODE,"B",I))
if I=""
QUIT
Begin DoDot:1
+4 SET DIV=$ORDER(^IBE(350.9,1,IBNODE,"B",I,""))
+5 if +DIV'>0
QUIT
SET PPROV=$$GETPROV(DIV,IBTCFLAG)
+6 IF PPROV=PIEN
IF DIV'=PIEN
SET DIVS(DIV)=$PIECE($GET(^IBE(350.9,1,IBNODE,DIV,0)),U,2)
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
NODE(IBTCFLAG) ; Determine appropriate pay-to provide node within ^IBE(350.9).
+1 ; '29' for TRICARE, otherwise '19'.
+2 QUIT $SELECT(IBTCFLAG:29,1:19)
+3 ;
SCRN4(IEN) ; Screen for INSTITUTION(#4) file
+1 NEW DIERR,IENS,FIELDS,Z,ZERR
+2 SET IENS=+IEN_","
SET FIELDS="11;13;101"
+3 DO GETS^DIQ(4,IENS,FIELDS,"IE","Z","ZERR")
+4 IF $DATA(DIERR)
QUIT 0
+5 ;Check to see if National
+6 IF Z(4,IENS,11,"I")'="N"
QUIT 0
+7 ;Check to see if Inactive
+8 IF Z(4,IENS,101,"I")
QUIT 0
+9 ;Check to see if Pharmacy
+10 IF "^PHARM^CMOP^MSN^"[(U_Z(4,IENS,13,"E")_U)
QUIT 0
+11 ;Default
+12 QUIT 1
+13 ;
TRICARE(IBIFN) ; Determine whether this bill/claim is TRICARE or not.
+1 ; Return '1' if TRICARE, '0' if not. There are two rate types that
+2 ; should return '1': TRICARE and TRICARE REIMB. INS.
+3 ;
+4 ; This has been modified to reflect Non-MCCF Claims and not just TRICARE. - IB*2.0*608 - vd (US2599)
+5 ;
+6 IF '$GET(IBIFN)
QUIT 0
+7 NEW IBRATE
+8 SET IBRATE=$PIECE(^DGCR(399,IBIFN,0),U,7)
+9 IF 'IBRATE
QUIT 0
+10 ;
+11 ;/Begin IB*2.0*608 - vd (US2599) - Replaced the following lines
+12 ; I $P($G(^DGCR(399.3,IBRATE,0)),U)'["TRICARE" Q 0
+13 ; Not a Non-MCCF Pay-to Provider Rate Type.
IF '$DATA(^IBE(350.9,1,28,"B",IBRATE))
QUIT 0
+14 ;/End IB*2.0*608 - vd
+15 ;
+16 ; At this point, the claim has a Non-MCCF rate type However,
+17 ; quit with a '1' only if a default Non-MCCF-specific pay-to
+18 ; provider is defined. Otherwise, quit with a '0'.
+19 ;
+20 IF $$GETDFLT^IBJPS3(1)
QUIT 1
+21 QUIT 0
