IBCEP4 ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00
;;2.0;INTEGRATED BILLING;**137,320,348,349,377,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point
N IBINS,IBALL,IB95
D ENX
Q
;
EN1(IBINS) ; -- Entry point from provider number maintenence
N IBPRV,IBALL,IB95
S VALMBCK="R"
D ENX
Q
;
ENX ; Common call to list template for dual entry points
N IBSLEV,DIR,Y
K IBFASTXT
D FULL^VALM1
S DIR(0)="SA^1:Performing Provider Care Units;2:Billing Provider Care Units"
S DIR("A")="Enter Type of Care Unit: ",DIR("B")=$P($P(DIR(0),":",2),";",1)
W ! D ^DIR K DIR W !
I Y'>0 Q
S IBSLEV=+Y
I IBSLEV=2 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT") Q
D EN^VALM("IBCE PRVCARE UNIT MAINT")
Q
;
HDR ; -- header
K VALMHDR
S VALMHDR(1)=" "
S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL")
Q
;
INIT ; -- init variables, list array
N Z,IB,IBLCT,IBENT,IBNM,IB0,Z0,Z1,IBQ,DIR,Y,X
I $G(IBINS) S Y=IBINS ; For entrypoint from provider number maintenance
;
I '$G(IBINS) D
. S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units"
. D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S Y=-2 Q
. I Y>0 S IBINS=+Y Q
;
I Y'=-2 D
. D BLD
E D
. S VALMQUIT=1
Q
;
BLD ; Bld display - IBINS must = ien of file 36
K ^TMP("IBPRV_CU",$J)
;
I $G(IBSLEV)=2 Q
;
S (IBENT,IBLCT)=0,IBNM=""
F S IBNM=$O(^IBA(355.95,"C",IBINS,IBNM)) Q:IBNM="" S Z=0 F S Z=$O(^IBA(355.95,"C",IBINS,IBNM,Z)) Q:'Z S IB=$G(^IBA(355.95,Z,0)) I IB'="",$P(IB,U,4)="" D
. S IBLCT=IBLCT+1,IBENT=IBENT+1
. I '$D(^IBA(355.96,"AUNIQ",IBINS,Z)) D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20)_" (NO COMBINATIONS FOUND)",IBENT) Q
. D SET^VALM10(IBLCT,$E(IBENT_" ",1,4)_$E($P(IB,U)_$J("",30),1,30)_" "_$E($P(IB,U,2)_$J("",20),1,20),IBENT)
. S ^TMP("IBPRV_CU",$J,"ZIDX",IBENT)=Z
. S Z0=0 F S Z0=$O(^IBA(355.96,"AE",Z,Z0)) Q:'Z0 S Z1=0 F S Z1=$O(^IBA(355.96,"AE",Z,Z0,Z1)) Q:'Z1 S IB0=$G(^IBA(355.96,Z1,0)) I IB0'="" D
.. S IBLCT=IBLCT+1
.. S IBQ=$J("",28)_"o "_$E($$EXPAND^IBTRE(355.96,.06,+$P(IB0,U,6))_$J("",20),1,20)
.. S IBQ=IBQ_" "_$E($P("Both Form Types^UB-04 Only^CMS-1500 Only",U,$P(IB0,U,4)+1)_$J("",15),1,15)_" "_$E($P("Inpt/Outpt^Inpt Only^Outpt Only^RX Only",U,+$P(IB0,U,5)+1)_$J("",10),1,10)
.. D SET^VALM10(IBLCT,IBQ,IBENT)
;
I 'IBLCT D SET^VALM10(1,"No CARE UNITs Found"_$S('$G(IBINS):"",1:" for Insurance Co")) S IBLCT=1
S VALMCNT=IBLCT,VALMBG=1
Q
;
HELP ; -- help
;
I $G(IBSLEV)=2 Q
;
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit
D CLEAN^VALM10
K ^TMP("IBPRV_CU",$J),IBINS,IBALL
Q
;
EXPND ;
Q
;
SEL(IBDA,MANY) ; Select from care unit list
; IBDA is passed by reference and IBDA(1) returned containing
; ien's of the care unit selected (file 355.95).
; If > 1 entry can be selected, MANY is set to 1
N Z
S IBDA=0
D EN^VALM2($G(XQORNOD(0)),$S($G(MANY):"",1:"S"))
S Z=0 F S Z=$O(VALMY(Z)) Q:'Z S IBDA=IBDA+1,IBDA(IBDA)=+$G(^TMP("IBPRV_CU",$J,"ZIDX",Z))
Q
;
DISP(IBVAR,IBINS,IBPTYP,IBFT,IBCT,START,END) ; Set up display array for
; provider id
N Z
S START=$S($G(START):START,1:1)
S (Z,END)=$G(START)
S @IBVAR@(START)="INSURANCE: "_$S(IBINS:$P($G(^DIC(36,+IBINS,0)),U),1:"ALL INSURANCE")
S @IBVAR@(START+1)="PROV TYPE: "_$$EXPAND^IBTRE(355.96,.06,IBPTYP)
S @IBVAR@(START+2)="FORM TYPE: "_$$EXPAND^IBTRE(355.96,.04,IBFT)
S @IBVAR@(START+3)="CARE TYPE: "_$$EXPAND^IBTRE(355.96,.05,IBCT)
S END=$G(START)+3
Q
;
CAREUOK(IBIFN,IBCU,IBTYPE,IBSEQ) ; Returns 1 if care unit is appropriate
; for bill based on provider type, care type, bill type and insurance co
; IBIFN = ien of bill (file 399)
; IBCU = the ien of the care unit (file 355.96)
; IBTYPE = type of ID being checked (1=performing, 2=EMC)
; IBSEQ = the COB seq being checked (1-3)
N Z,IBOK,IBINS,IBCT,IBFT,IBPTYP,IBRX
S IBOK=0
S IBINS=+$$FINDINS^IBCEF1(IBIFN,+IBSEQ),IBFT=$S($$FT^IBCEF(IBIFN)=2:2,1:1)
S IBPTYP=+$S(IBTYPE=1:$$PPTYP^IBCEP0(IBINS),1:$$EMCID^IBCEP())
S IBRX=$$ISRX^IBCEF1(IBIFN)
S IBCT=$S('IBRX:$S($$INPAT^IBCEF(IBIFN,1):1,1:2),1:3)
;Check from most general to most specific
I $D(^IBA(355.96,"AD",IBINS,0,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
I 'IBRX,$D(^IBA(355.96,"AD",IBINS,IBFT,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
I $D(^IBA(355.96,"AD",IBINS,0,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
I $D(^IBA(355.96,"AD",IBINS,IBFT,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
;
CAREOKQ Q IBOK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP4 4647 printed Apr 09, 2024@21:25:45 Page 2
IBCEP4 ;ALB/TMP - EDI UTILITIES for provider ID ;29-SEP-00
+1 ;;2.0;INTEGRATED BILLING;**137,320,348,349,377,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point
+1 NEW IBINS,IBALL,IB95
+2 DO ENX
+3 QUIT
+4 ;
EN1(IBINS) ; -- Entry point from provider number maintenence
+1 NEW IBPRV,IBALL,IB95
+2 SET VALMBCK="R"
+3 DO ENX
+4 QUIT
+5 ;
ENX ; Common call to list template for dual entry points
+1 NEW IBSLEV,DIR,Y
+2 KILL IBFASTXT
+3 DO FULL^VALM1
+4 SET DIR(0)="SA^1:Performing Provider Care Units;2:Billing Provider Care Units"
+5 SET DIR("A")="Enter Type of Care Unit: "
SET DIR("B")=$PIECE($PIECE(DIR(0),":",2),";",1)
+6 WRITE !
DO ^DIR
KILL DIR
WRITE !
+7 IF Y'>0
QUIT
+8 SET IBSLEV=+Y
+9 IF IBSLEV=2
DO EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT")
QUIT
+10 DO EN^VALM("IBCE PRVCARE UNIT MAINT")
+11 QUIT
+12 ;
HDR ; -- header
+1 KILL VALMHDR
+2 SET VALMHDR(1)=" "
+3 SET VALMHDR(2)="Insurance Co: "_$SELECT('$GET(IBALL)&$GET(IBINS):$PIECE($GET(^DIC(36,+IBINS,0)),U),1:"ALL")
+4 QUIT
+5 ;
INIT ; -- init variables, list array
+1 NEW Z,IB,IBLCT,IBENT,IBNM,IB0,Z0,Z1,IBQ,DIR,Y,X
+2 ; For entrypoint from provider number maintenance
IF $GET(IBINS)
SET Y=IBINS
+3 ;
+4 IF '$GET(IBINS)
Begin DoDot:1
+5 SET DIR(0)="PA^DIC(36,:AEMQ"
SET DIR("A")="Select INSURANCE CO: "
SET DIR("?")="Select an INSURANCE CO to display its care units"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y=-2
QUIT
+8 IF Y>0
SET IBINS=+Y
QUIT
End DoDot:1
+9 ;
+10 IF Y'=-2
Begin DoDot:1
+11 DO BLD
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET VALMQUIT=1
End DoDot:1
+14 QUIT
+15 ;
BLD ; Bld display - IBINS must = ien of file 36
+1 KILL ^TMP("IBPRV_CU",$JOB)
+2 ;
+3 IF $GET(IBSLEV)=2
QUIT
+4 ;
+5 SET (IBENT,IBLCT)=0
SET IBNM=""
+6 FOR
SET IBNM=$ORDER(^IBA(355.95,"C",IBINS,IBNM))
if IBNM=""
QUIT
SET Z=0
FOR
SET Z=$ORDER(^IBA(355.95,"C",IBINS,IBNM,Z))
if 'Z
QUIT
SET IB=$GET(^IBA(355.95,Z,0))
IF IB'=""
IF $PIECE(IB,U,4)=""
Begin DoDot:1
+7 SET IBLCT=IBLCT+1
SET IBENT=IBENT+1
+8 IF '$DATA(^IBA(355.96,"AUNIQ",IBINS,Z))
DO SET^VALM10(IBLCT,$EXTRACT(IBENT_" ",1,4)_$EXTRACT($PIECE(IB,U)_$JUSTIFY("",30),1,30)_" "_$EXTRACT($PIECE(IB,U,2)_$JUSTIFY("",20),1,20)_" (NO COMBINATIONS FOUND)",IBENT)
QUIT
+9 DO SET^VALM10(IBLCT,$EXTRACT(IBENT_" ",1,4)_$EXTRACT($PIECE(IB,U)_$JUSTIFY("",30),1,30)_" "_$EXTRACT($PIECE(IB,U,2)_$JUSTIFY("",20),1,20),IBENT)
+10 SET ^TMP("IBPRV_CU",$JOB,"ZIDX",IBENT)=Z
+11 SET Z0=0
FOR
SET Z0=$ORDER(^IBA(355.96,"AE",Z,Z0))
if 'Z0
QUIT
SET Z1=0
FOR
SET Z1=$ORDER(^IBA(355.96,"AE",Z,Z0,Z1))
if 'Z1
QUIT
SET IB0=$GET(^IBA(355.96,Z1,0))
IF IB0'=""
Begin DoDot:2
+12 SET IBLCT=IBLCT+1
+13 SET IBQ=$JUSTIFY("",28)_"o "_$EXTRACT($$EXPAND^IBTRE(355.96,.06,+$PIECE(IB0,U,6))_$JUSTIFY("",20),1,20)
+14 SET IBQ=IBQ_" "_$EXTRACT($PIECE("Both Form Types^UB-04 Only^CMS-1500 Only",U,$PIECE(IB0,U,4)+1)_$JUSTIFY("",15),1,15)_" "_$EXTRACT($PIECE("Inpt/Outpt^Inpt Only^Outpt Only^RX Only",U,+$PIECE(IB0,U,5)+1)_$JUS
TIFY("",10),1,10)
+15 DO SET^VALM10(IBLCT,IBQ,IBENT)
End DoDot:2
End DoDot:1
+16 ;
+17 IF 'IBLCT
DO SET^VALM10(1,"No CARE UNITs Found"_$SELECT('$GET(IBINS):"",1:" for Insurance Co"))
SET IBLCT=1
+18 SET VALMCNT=IBLCT
SET VALMBG=1
+19 QUIT
+20 ;
HELP ; -- help
+1 ;
+2 IF $GET(IBSLEV)=2
QUIT
+3 ;
+4 SET X="?"
DO DISP^XQORM1
WRITE !!
+5 QUIT
+6 ;
EXIT ; -- exit
+1 DO CLEAN^VALM10
+2 KILL ^TMP("IBPRV_CU",$JOB),IBINS,IBALL
+3 QUIT
+4 ;
EXPND ;
+1 QUIT
+2 ;
SEL(IBDA,MANY) ; Select from care unit list
+1 ; IBDA is passed by reference and IBDA(1) returned containing
+2 ; ien's of the care unit selected (file 355.95).
+3 ; If > 1 entry can be selected, MANY is set to 1
+4 NEW Z
+5 SET IBDA=0
+6 DO EN^VALM2($GET(XQORNOD(0)),$SELECT($GET(MANY):"",1:"S"))
+7 SET Z=0
FOR
SET Z=$ORDER(VALMY(Z))
if 'Z
QUIT
SET IBDA=IBDA+1
SET IBDA(IBDA)=+$GET(^TMP("IBPRV_CU",$JOB,"ZIDX",Z))
+8 QUIT
+9 ;
DISP(IBVAR,IBINS,IBPTYP,IBFT,IBCT,START,END) ; Set up display array for
+1 ; provider id
+2 NEW Z
+3 SET START=$SELECT($GET(START):START,1:1)
+4 SET (Z,END)=$GET(START)
+5 SET @IBVAR@(START)="INSURANCE: "_$SELECT(IBINS:$PIECE($GET(^DIC(36,+IBINS,0)),U),1:"ALL INSURANCE")
+6 SET @IBVAR@(START+1)="PROV TYPE: "_$$EXPAND^IBTRE(355.96,.06,IBPTYP)
+7 SET @IBVAR@(START+2)="FORM TYPE: "_$$EXPAND^IBTRE(355.96,.04,IBFT)
+8 SET @IBVAR@(START+3)="CARE TYPE: "_$$EXPAND^IBTRE(355.96,.05,IBCT)
+9 SET END=$GET(START)+3
+10 QUIT
+11 ;
CAREUOK(IBIFN,IBCU,IBTYPE,IBSEQ) ; Returns 1 if care unit is appropriate
+1 ; for bill based on provider type, care type, bill type and insurance co
+2 ; IBIFN = ien of bill (file 399)
+3 ; IBCU = the ien of the care unit (file 355.96)
+4 ; IBTYPE = type of ID being checked (1=performing, 2=EMC)
+5 ; IBSEQ = the COB seq being checked (1-3)
+6 NEW Z,IBOK,IBINS,IBCT,IBFT,IBPTYP,IBRX
+7 SET IBOK=0
+8 SET IBINS=+$$FINDINS^IBCEF1(IBIFN,+IBSEQ)
SET IBFT=$SELECT($$FT^IBCEF(IBIFN)=2:2,1:1)
+9 SET IBPTYP=+$SELECT(IBTYPE=1:$$PPTYP^IBCEP0(IBINS),1:$$EMCID^IBCEP())
+10 SET IBRX=$$ISRX^IBCEF1(IBIFN)
+11 SET IBCT=$SELECT('IBRX:$SELECT($$INPAT^IBCEF(IBIFN,1):1,1:2),1:3)
+12 ;Check from most general to most specific
+13 IF $DATA(^IBA(355.96,"AD",IBINS,0,0,IBPTYP,IBCU))
SET IBOK=1
GOTO CAREOKQ
+14 IF 'IBRX
IF $DATA(^IBA(355.96,"AD",IBINS,IBFT,0,IBPTYP,IBCU))
SET IBOK=1
GOTO CAREOKQ
+15 IF $DATA(^IBA(355.96,"AD",IBINS,0,IBCT,IBPTYP,IBCU))
SET IBOK=1
GOTO CAREOKQ
+16 IF $DATA(^IBA(355.96,"AD",IBINS,IBFT,IBCT,IBPTYP,IBCU))
SET IBOK=1
GOTO CAREOKQ
+17 ;
CAREOKQ QUIT IBOK
+1 ;
