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

IBCEPB.m

Go to the documentation of this file.
  1. IBCEPB ;ALB/WCJ - Insurance company ID parameters ;22-DEC-2005
  1. ;;2.0;INTEGRATED BILLING;**320,348,349,400,516,592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. EN ; -- main entry point for IBCE INSCO ID MAINT
  1. D EN^VALM("IBCE INSCO ID MAINT")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N PCF,PCDISP
  1. I '$D(IBCNS) N IBCNS S IBCNS=IBINS
  1. S PCF=$P($G(^DIC(36,+IBCNS,3)),U,13),PCDISP=$S(PCF="P":"(Parent)",1:"")
  1. S VALMHDR(1)="Insurance Co: "_$P($G(^DIC(36,+IBCNS,0)),U)_PCDISP
  1. Q
  1. ;
  1. INIT ; Initialize
  1. D CLEAN^VALM10
  1. I '$D(IBCNS) N IBCNS S IBCNS=IBINS
  1. N IBLCT
  1. S IBLCT=0
  1. ; Display the list
  1. D SET1(.IBLCT,"Attending/Rendering Provider Secondary ID")
  1. D SET1(.IBLCT,"Default ID (1500): "_$$GET1^DIQ(36,IBCNS,4.01))
  1. D SET1(.IBLCT,"Default ID (UB-04): "_$$GET1^DIQ(36,IBCNS,4.02))
  1. D SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.03))
  1. D SET1(.IBLCT," ")
  1. D SET1(.IBLCT,"Referring Provider Secondary ID")
  1. D SET1(.IBLCT,"Default ID (1500): "_$$GET1^DIQ(36,IBCNS,4.04))
  1. D SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.05))
  1. D SET1(.IBLCT," ")
  1. D SET1(.IBLCT,"Billing Provider Secondary IDs")
  1. D SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (1500)?: "_$$GET1^DIQ(36,IBCNS,4.06))
  1. D SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (UB-04)?: "_$$GET1^DIQ(36,IBCNS,4.08))
  1. D SET1(.IBLCT,"Transmit no Billing Provider Sec ID for the following Electronic Plan Types:")
  1. D LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
  1. F I=1:1:+$G(TAR("DILIST",0)) D
  1. . D SET1(.IBLCT,TAR("DILIST",1,I))
  1. D SET1(.IBLCT," ")
  1. ;JWS;IB*2.0*592;This header was left around after the 516 patch change below, not necessary
  1. ;D SET1(.IBLCT,"Billing Provider/Service Facility")
  1. ;S IBCNS4=$G(^DIC(36,+IBCNS,4))
  1. ; MRD;IB*2.0*516 - Marked fields 4.07, 4.11, 4.12 and 4.13 for
  1. ; deletion and removed all references to them.
  1. ;D SET1(.IBLCT,"Always use main VAMC as Billing Provider (1500)?: "_$$EXPAND^IBTRE(36,4.11,+$P(IBCNS4,U,11)))
  1. ;D SET1(.IBLCT,"Always use main VAMC as Billing Provider (UB-04)?: "_$$EXPAND^IBTRE(36,4.12,+$P(IBCNS4,U,12)))
  1. ;I $P(IBCNS4,U,11)!($P(IBCNS4,U,12)) D
  1. ;.D SET1(.IBLCT,"Send VA Lab/Facility IDs or Facility Data for VAMC?: "_$$EXPAND^IBTRE(36,4.07,+$P(IBCNS4,U,7)))
  1. ;.D SET1(.IBLCT,"Use the Billing Prov (VAMC) Name and Street Address?: "_$$EXPAND^IBTRE(36,4.13,+$P(IBCNS4,U,13)))
  1. ;.Q
  1. ;
  1. S VALMBG=1,VALMCNT=IBLCT
  1. Q
  1. ;
  1. SET1(IBLCT,TEXT,IBCT) ;
  1. S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT)
  1. Q
  1. ;
  1. EXPND ;
  1. Q
  1. HELP ;
  1. Q
  1. EXIT ;
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. IDPARAM ;
  1. D FULL^VALM1
  1. N DIE,DA,DR
  1. I '$D(IBCNS) N IBCNS S IBCNS=IBINS
  1. S DIE="^DIC(36,",(DA,Y)=IBCNS,DR="[IBEDIT INS CO1]"
  1. I '$D(IBY) N IBY S IBY=",12,"
  1. D ^DIE K DIE
  1. K ^TMP("IBCE_PRVFAC_MAINT",$J)
  1. D INIT
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. BILLPRVP ;
  1. D FULL^VALM1
  1. D EN^IBCEPC
  1. D INIT
  1. K ^TMP("IBCE_PRVFAC_MAINT",$J)
  1. S VALMBCK="R"
  1. Q