Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEP4

IBCEP4.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point
  1. N IBINS,IBALL,IB95
  1. D ENX
  1. Q
  1. ;
  1. EN1(IBINS) ; -- Entry point from provider number maintenence
  1. N IBPRV,IBALL,IB95
  1. S VALMBCK="R"
  1. D ENX
  1. Q
  1. ;
  1. ENX ; Common call to list template for dual entry points
  1. N IBSLEV,DIR,Y
  1. K IBFASTXT
  1. D FULL^VALM1
  1. S DIR(0)="SA^1:Performing Provider Care Units;2:Billing Provider Care Units"
  1. S DIR("A")="Enter Type of Care Unit: ",DIR("B")=$P($P(DIR(0),":",2),";",1)
  1. W ! D ^DIR K DIR W !
  1. I Y'>0 Q
  1. S IBSLEV=+Y
  1. I IBSLEV=2 D EN^VALM("IBCE 2ND PRVID CARE UNIT MAINT") Q
  1. D EN^VALM("IBCE PRVCARE UNIT MAINT")
  1. Q
  1. ;
  1. HDR ; -- header
  1. K VALMHDR
  1. S VALMHDR(1)=" "
  1. S VALMHDR(2)="Insurance Co: "_$S('$G(IBALL)&$G(IBINS):$P($G(^DIC(36,+IBINS,0)),U),1:"ALL")
  1. Q
  1. ;
  1. INIT ; -- init variables, list array
  1. N Z,IB,IBLCT,IBENT,IBNM,IB0,Z0,Z1,IBQ,DIR,Y,X
  1. I $G(IBINS) S Y=IBINS ; For entrypoint from provider number maintenance
  1. ;
  1. I '$G(IBINS) D
  1. . S DIR(0)="PA^DIC(36,:AEMQ",DIR("A")="Select INSURANCE CO: ",DIR("?")="Select an INSURANCE CO to display its care units"
  1. . D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S Y=-2 Q
  1. . I Y>0 S IBINS=+Y Q
  1. ;
  1. I Y'=-2 D
  1. . D BLD
  1. E D
  1. . S VALMQUIT=1
  1. Q
  1. ;
  1. BLD ; Bld display - IBINS must = ien of file 36
  1. K ^TMP("IBPRV_CU",$J)
  1. ;
  1. I $G(IBSLEV)=2 Q
  1. ;
  1. S (IBENT,IBLCT)=0,IBNM=""
  1. 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
  1. . S IBLCT=IBLCT+1,IBENT=IBENT+1
  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
  1. . 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)
  1. . S ^TMP("IBPRV_CU",$J,"ZIDX",IBENT)=Z
  1. . 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
  1. .. S IBLCT=IBLCT+1
  1. .. S IBQ=$J("",28)_"o "_$E($$EXPAND^IBTRE(355.96,.06,+$P(IB0,U,6))_$J("",20),1,20)
  1. .. 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)
  1. .. D SET^VALM10(IBLCT,IBQ,IBENT)
  1. ;
  1. I 'IBLCT D SET^VALM10(1,"No CARE UNITs Found"_$S('$G(IBINS):"",1:" for Insurance Co")) S IBLCT=1
  1. S VALMCNT=IBLCT,VALMBG=1
  1. Q
  1. ;
  1. HELP ; -- help
  1. ;
  1. I $G(IBSLEV)=2 Q
  1. ;
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit
  1. D CLEAN^VALM10
  1. K ^TMP("IBPRV_CU",$J),IBINS,IBALL
  1. Q
  1. ;
  1. EXPND ;
  1. Q
  1. ;
  1. SEL(IBDA,MANY) ; Select from care unit list
  1. ; IBDA is passed by reference and IBDA(1) returned containing
  1. ; ien's of the care unit selected (file 355.95).
  1. ; If > 1 entry can be selected, MANY is set to 1
  1. N Z
  1. S IBDA=0
  1. D EN^VALM2($G(XQORNOD(0)),$S($G(MANY):"",1:"S"))
  1. S Z=0 F S Z=$O(VALMY(Z)) Q:'Z S IBDA=IBDA+1,IBDA(IBDA)=+$G(^TMP("IBPRV_CU",$J,"ZIDX",Z))
  1. Q
  1. ;
  1. DISP(IBVAR,IBINS,IBPTYP,IBFT,IBCT,START,END) ; Set up display array for
  1. ; provider id
  1. N Z
  1. S START=$S($G(START):START,1:1)
  1. S (Z,END)=$G(START)
  1. S @IBVAR@(START)="INSURANCE: "_$S(IBINS:$P($G(^DIC(36,+IBINS,0)),U),1:"ALL INSURANCE")
  1. S @IBVAR@(START+1)="PROV TYPE: "_$$EXPAND^IBTRE(355.96,.06,IBPTYP)
  1. S @IBVAR@(START+2)="FORM TYPE: "_$$EXPAND^IBTRE(355.96,.04,IBFT)
  1. S @IBVAR@(START+3)="CARE TYPE: "_$$EXPAND^IBTRE(355.96,.05,IBCT)
  1. S END=$G(START)+3
  1. Q
  1. ;
  1. 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
  1. ; IBIFN = ien of bill (file 399)
  1. ; IBCU = the ien of the care unit (file 355.96)
  1. ; IBTYPE = type of ID being checked (1=performing, 2=EMC)
  1. ; IBSEQ = the COB seq being checked (1-3)
  1. N Z,IBOK,IBINS,IBCT,IBFT,IBPTYP,IBRX
  1. S IBOK=0
  1. S IBINS=+$$FINDINS^IBCEF1(IBIFN,+IBSEQ),IBFT=$S($$FT^IBCEF(IBIFN)=2:2,1:1)
  1. S IBPTYP=+$S(IBTYPE=1:$$PPTYP^IBCEP0(IBINS),1:$$EMCID^IBCEP())
  1. S IBRX=$$ISRX^IBCEF1(IBIFN)
  1. S IBCT=$S('IBRX:$S($$INPAT^IBCEF(IBIFN,1):1,1:2),1:3)
  1. ;Check from most general to most specific
  1. I $D(^IBA(355.96,"AD",IBINS,0,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
  1. I 'IBRX,$D(^IBA(355.96,"AD",IBINS,IBFT,0,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
  1. I $D(^IBA(355.96,"AD",IBINS,0,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
  1. I $D(^IBA(355.96,"AD",IBINS,IBFT,IBCT,IBPTYP,IBCU)) S IBOK=1 G CAREOKQ
  1. ;
  1. CAREOKQ Q IBOK
  1. ;