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

IBCEU5.m

Go to the documentation of this file.
  1. IBCEU5 ;ALB/TMP - EDI UTILITIES (continued) FOR CMS-1500 ;13-DEC-99
  1. ;;2.0;INTEGRATED BILLING;**51,137,232,348,349,432,592,608**;21-MAR-94;Build 90
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. EXTCR(IBPRV) ; Called by trigger on field .02 of file 399.0222
  1. ; Also called by trigger on field .02 of file 399.0404 (DEM;432).
  1. ; Function returns the first 3 digits of the provider's degree if
  1. ; a VA provider or the credentials in file 355.9 if non-VA provider
  1. ; IBPRV = vp to file 200 or 355.93
  1. Q $E($$CRED^IBCEU(IBPRV),1,3)
  1. ;
  1. FTPRV(IBIFN,NOASK) ; If form type changes from UB-04 to CMS-1500 or vice
  1. ; versa, ask to change provider function to appropriate function for
  1. ; form type (ATTENDING = UB-04, RENDERING = CMS-1500)
  1. ; IBIFN = ien of bill in file 399
  1. ; NOASK (flag) = 1 if change should happen without asking first
  1. N ATT,REN,FT
  1. S FT=$$FT^IBCEF(IBIFN)
  1. S REN=$$CKPROV^IBCEU(IBIFN,3,1)
  1. S ATT=$$CKPROV^IBCEU(IBIFN,4,1)
  1. ;JWS;IB*2.0*592;add Dental form check
  1. I $S(FT=2:'REN&ATT,FT=3:'ATT&REN,FT=7:'REN&ATT,1:0) D
  1. . I '$G(NOASK) D TXFERPRV(IBIFN,FT) Q
  1. . D PRVCHG(IBIFN,FT)
  1. D CLEANUP(IBIFN,FT)
  1. Q
  1. ;
  1. TXFERPRV(IBIFN,FT) ; Ask to change the function of the main provider on
  1. ; bill IBIFN to the function appropriate to the form type FT
  1. ;
  1. N DIR,X,Y,Z,DIE,DA,DR,HAVE,NEED,IBZ
  1. ; DEM;432 - Changed the prompt from uppercase to mixed case.
  1. W ! S DIR("A")=" Change the Claim Level "_$S(FT=3:"Rendering",1:"Attending")_" provider's function to "_$S(FT=3:"Attending",1:"Rendering")_"?: "
  1. S DIR(0)="YA",DIR("B")="NO",DIR("?",1)="If you answer YES here, you will make the claim level provider functions",DIR("?")=" consistent with the form type of the bill"
  1. D ^DIR K DIR
  1. I Y'=1 Q
  1. D PRVCHG(IBIFN,FT)
  1. Q
  1. ;
  1. PRVCHG(IBIFN,IBFT) ; Change provider type to type consistent with current
  1. ; data on bill
  1. N Z,IBZ,HAVE,NEED,DIE,DA,X,Y
  1. S HAVE=$S(IBFT=3:3,1:4)
  1. S NEED=$S(IBFT=3:4,1:3)
  1. S Z=$O(^DGCR(399,IBIFN,"PRV","B",HAVE,0))
  1. I Z D
  1. . S DA(1)=IBIFN,DA=+Z
  1. . D FDA^DILF(399.0222,.DA,.01,,NEED,"IBZ")
  1. . D FILE^DIE(,"IBZ")
  1. ;I Z S DA(1)=IBIFN,DIE="^DGCR(399,"_DA(1)_",""PRV"",",DA=+Z,DR=".01////"_NEED D FILE^DIE(,DIE
  1. Q
  1. ;
  1. CLEANUP(IBIFN,FT) ; If form type changes remove any extra provider FUNCTIONS.
  1. N X,PRV,CLEAN,DA,DIE
  1. ;
  1. ;JWS;IB*2.0*592 US1108 - If form type changes to (7) J430D - Dental, default Bill Charge Type
  1. I FT=7 S CLEAN(399,IBIFN_",",.27)=2
  1. ; (3) If form type changes from CMS-1500 to UB-04, remove any extra provider FUNCTIONS.
  1. ;JWS;IB*2.0*592 US1108 - added 6-ASSISTANT SURGEON
  1. I FT=3 F X=5,6 D ; 5-SUPERVISING, 6-ASSISTANT SURGEON
  1. . I $D(^DGCR(399,IBIFN,"PRV","B",X)) D
  1. .. S PRV=0 F S PRV=$O(^DGCR(399,IBIFN,"PRV","B",X,PRV)) Q:+PRV=0 D
  1. ... S DA(1)=IBIFN,DA=PRV D FDA^DILF(399.0222,.DA,.01,,"@","CLEAN")
  1. ;
  1. ; (2) If form type changes from UB-04 to CMS-1500, remove any extra provider FUNCTIONS.
  1. ;JWS;IB*2.0*592 US1108 - added 6-ASSISTANT SURGEON
  1. I FT=2 F X=2,4,6,9 D ; 2-OPERATING, 4-ATTENDING, 6-ASSISTANT SURGEON, 9-OTHER
  1. . I $D(^DGCR(399,IBIFN,"PRV","B",X)) D
  1. .. S PRV=0 F S PRV=$O(^DGCR(399,IBIFN,"PRV","B",X,PRV)) Q:+PRV=0 D
  1. ... S DA(1)=IBIFN,DA=PRV D FDA^DILF(399.0222,.DA,.01,,"@","CLEAN")
  1. ;
  1. I $D(CLEAN) D FILE^DIE(,"CLEAN")
  1. Q
  1. ;
  1. PRVHELP ; Text for the provider function help
  1. Q:$G(X)'="??"
  1. N IBZ,IBQUIT,IB,IB1,DIR,Z
  1. S IBQUIT=0
  1. S Z=""
  1. I '$D(IOSL)!'$D(IOST) D HOME^%ZIS
  1. Q:IOST'["C-"
  1. D:$G(D0) SPECIFIC(D0)
  1. N DIR,X,Y S DIR(0)="E" D ^DIR K DIR W @IOF
  1. S:$G(D0) Z=$$FT^IBCEF(D0)
  1. S IB=IOSL,IB1=1
  1. F IBZ=1:1 S:$P($T(HLPTXT+IBZ),";;",2)="" IBQUIT=1 Q:IBQUIT S IB1=1 D
  1. . I $Y>(IB-3) N DIR,X,Y S IB1=0,DIR(0)="E" D ^DIR K DIR S IB=IB+IOSL I Y'=1 S IBQUIT=1 Q
  1. . W !,$P($T(HLPTXT+IBZ),";;",2)
  1. I IB1 D
  1. . N DIR,X,Y S DIR(0)="E" D ^DIR K DIR
  1. W @IOF
  1. Q
  1. ;
  1. SPECIFIC(IBIFN) ; Display specific provider requirements for the bill IBIFN
  1. N IBFT,IBPRV,IBR,ONBILL,Z,IBZ
  1. S IBFT=$$FT^IBCEF(IBIFN)
  1. D GETPRV^IBCEU(IBIFN,"ALL",.IBPRV) ;Returns needed providers
  1. ;JWS;IB*2.0*592 US1108 - added Dental form #7
  1. W !,"This bill is ",$S(IBFT=7:"J430D",IBFT=3:"UB-04",1:"CMS-1500"),"/",$S($$INPAT^IBCEF(IBIFN):"Inpatient",1:"Outpatient")
  1. W !!,"The valid provider functions for this bill are:"
  1. ;JWS;IB*2.0*592 US1108 - changed loop from :5 to :6 for Assistant Surgeon
  1. F IBZ=1:1:6,9 I $$PRVOK^IBCEU(IBZ,IBIFN) D
  1. . S ONBILL=$$CKPROV^IBCEU(IBIFN,IBZ)
  1. . S IBR=$S($G(IBPRV(IBZ,"NOTOPT")):1,$G(IBPRV(IBZ,"SITUATIONAL")):2,1:0) ; DEM;432 added "SITUATIONAL" check.
  1. . ;JWS;IB*2.0*592 US1108 - dental form#7
  1. . I IBFT=7 S IBR=2
  1. . ; ib2.0*432
  1. . ; W !,IBZ," ",$$EXPAND^IBTRE(399.0222,.01,IBZ),?18,$S(IBR&'ONBILL:"**",1:""),?20,$S(IBR:"REQUIRED",1:"OPTIONAL"),$S(ONBILL:" - ALREADY ON BILL",1:" - NOT ON BILL")
  1. . W !,IBZ," ",$$EXPAND^IBTRE(399.0222,.01,IBZ),?18,$S(IBR&'ONBILL:"**",1:""),?23,$S(IBR=1:"REQUIRED",IBR=2:"SITUATIONAL",1:"OPTIONAL")
  1. W !
  1. Q
  1. ;
  1. HLPTXT ; Helptext for provider function
  1. ;;
  1. ;;PROVIDER FUNCTION requirements:
  1. ;;
  1. ;;RENDERING: UB-04 Situational, CMS-1500 Situational, or J430D Situational
  1. ;; This is the provider who performed a service.
  1. ;;
  1. ;;ATTENDING: UB-04 REQUIRED
  1. ;; The physician who has primary responsibility
  1. ;; for the patient's medical care and treatment.
  1. ;;
  1. ;;OPERATING: UB-04 SITUATIONAL
  1. ;; The provider who performed the principal procedure(s)
  1. ;; being billed.
  1. ;; UB-04 (inpatient): Situational IF type of bill has first 2
  1. ;; digits of 11, and there is a principal
  1. ;; procedure that will print in Form
  1. ;; Locator 74 of the claim, there must be
  1. ;; an Operating or Rendering Provider.
  1. ;; UB-04 (outpatient):REQUIRED IF type of bill has first 2
  1. ;; digits of 83, and there is a principal
  1. ;; procedure that will print in Form
  1. ;; Locator 74 of the claim.
  1. ;;
  1. ;;REFERRING: UB-04, CMS-1500, or J430D SITUATIONAL
  1. ;; The provider who referred the patient for the services being billed.
  1. ;;
  1. ;;SUPERVISING: CMS-1500 OPTIONAL or J430D SITUATIONAL
  1. ;; Required when the rendering provider is supervised
  1. ;; by another provider. Data will not be printed.
  1. ;;
  1. ;;OTHER OPERATING: UB-04 SITUATIONAL
  1. ;; Used to report another Operating Physician. There must
  1. ;; also be an Operating Physician on the claim.
  1. ;;
  1. ;;ASSISTANT SURGEON: J430D SITUATIONAL
  1. ;; Use when the Rendering Provider provided these services in the role
  1. ;; of the Assisting Surgeon.
  1. ;;
  1. ;; There are providers who performed specific functions for
  1. ;; the services on this bill. These providers are needed to
  1. ;; enable the V.A. to collect reimbursement when more than
  1. ;; one provider function is involved in the billable episode
  1. ;; (like an operating physician or referring provider).
  1. ;;
  1. ;; This data identifies the type of function that was performed
  1. ;; by a provider.
  1. ;;
  1. ;
  1. LINKRX(IBIFN,IBREV) ; Ask for revenue code's RX if not already there
  1. N DIR,X,Y,IBZ,IBRX,Z,Z0,DA
  1. Q:$P($G(^DGCR(399,IBIFN,"RC",IBREV,0)),U,11)!($P($G(^(0)),U,10)'=3)
  1. S Z=0 F S Z=$O(^DGCR(399,IBIFN,"RC",Z)) Q:'Z I Z'=IBREV S Z0=$G(^(Z,0)) I $P(Z0,U,10)=3,$P(Z0,U,11) S IBRX(+$P(Z0,U,11))=""
  1. S DIR(0)="PAO^IBA(362.4,:AEMQ",DIR("S")="I $P(^(0),U,2)=IBIFN,'$D(IBRX(+Y))"
  1. S DIR("A")="Select Rx for this charge: "
  1. S DIR("?",1)="Enter an Rx# for this revenue code"
  1. S DIR("?")=" The Rx must not already have an associated revenue code"
  1. D ^DIR K DIR
  1. I Y>0 D
  1. . S DA(1)=IBIFN,DA=IBREV,IBZ=""
  1. . D FDA^DILF(399.042,.DA,.11,"R",+Y,"IBZ")
  1. . D FILE^DIE(,"IBZ")
  1. Q
  1. ;
  1. LINKCPT(IBIFN,IBREV) ; Ask for revenue code's CPT
  1. N DIR,X,Y,IBZ,IBCP,Z,Z0,Z1,DA,IBRC,IBP
  1. S IBRC=$G(^DGCR(399,IBIFN,"RC",IBREV,0))
  1. Q:$P(IBRC,U,8)!($P(IBRC,U,10)'=4)
  1. S IBP=+$P(IBRC,U,6)
  1. I $P(IBRC,U,11) W !,"PROCEDURE #"_$P(IBRC,U,11)_" HAS BEEN ASSOCIATED WITH THIS MANUAL CHARGE"
  1. I '$P(IBRC,U,11) D Q:IBRC=""
  1. . S DIR("?",1)="Respond YES if this revenue code charge specifically references the data for"
  1. . S DIR("?",2)=" a particular procedure that was manually entered on the previous screen."
  1. . S DIR("?",3)=" For outpatient UB-04 bills, associating a manual revenue code charge with",DIR("?")=" a procedure is the only way to print a modifier in box 44"
  1. . S DIR(0)="YA",DIR("A")="SHOULD A PROCEDURE ENTRY BE ASSOCIATED WITH THIS CHARGE?: ",DIR("B")=$S(IBP:"YES",1:"NO") W ! D ^DIR K DIR W !
  1. . I Y'=1 S IBRC="" Q
  1. I $P(IBRC,U,11) D
  1. . S DIR("?",1)="Respond YES if you no longer want this revenue code charge to reference a",DIR("?")=" specific manually entered procedure"
  1. . S DIR(0)="YA",DIR("A")="DELETE THE EXISTING PROCEDURE ASSOCIATION?: ",DIR("B")="NO" W ! D ^DIR K DIR
  1. . I Y=1 D UPDPTR(IBIFN,IBREV,"") S $P(IBRC,U,11)=""
  1. S Z=0 F S Z=$O(^DGCR(399,IBIFN,"RC",Z)) Q:'Z S Z0=$G(^(Z,0)) I IBREV'=Z,$P(Z0,U,11) D
  1. . ; Don't allow to link to 'used' proc
  1. . I $P(Z0,U,10)=4 S IBCP($P(Z0,U,11))="" Q
  1. . I $P(Z0,U,10)=3,$P(Z0,U,15) S IBCP($P(Z0,U,15))=""
  1. S DIR(0)="PAO^DGCR(399,"_IBIFN_",""CP"",:AEMQ",DIR("S")="I '$D(IBCP(+Y)),$P(^(0),U)[""CPT"",+^(0)="_+$P($G(^DGCR(399,IBIFN,"RC",IBREV,0)),U,6)
  1. S DIR("A")="SELECT A PROCEDURE ENTRY: "_$S($P(IBRC,U,11):"#"_$P(IBRC,U,11)_" - "_$$EXPAND^IBTRE(399.0304,.01,$P($G(^DGCR(399,IBIFN,"CP",$P(IBRC,U,11),0)),U))_"// ",1:"")
  1. S DIR("?")="Enter a manually-added CPT procedure to associate with this charge"
  1. S DA(1)=IBIFN
  1. D ^DIR K DIR W !
  1. I Y>0 D UPDPTR(IBIFN,IBREV,+Y)
  1. Q
  1. ;
  1. UPDPTR(IBIFN,IBREV,Y) ;
  1. N IBZ,DA
  1. S DA(1)=IBIFN,DA=IBREV,IBZ=""
  1. D FDA^DILF(399.042,.DA,.11,"R",$S(Y:+Y,1:""),"IBZ")
  1. D FILE^DIE(,"IBZ")
  1. Q
  1. ;
  1. INSFT(IBIFN) ; Returns 1 if form type is UB-04, 0 if CMS-1500 or J430D
  1. Q ($$FT^IBCEF(IBIFN)=3)