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