- IBCEPB ;ALB/WCJ - Insurance company ID parameters ;22-DEC-2005
- ;;2.0;INTEGRATED BILLING;**320,348,349,400,516,592**;21-MAR-94;Build 58
- ;;Per VA Directive 6402, this routine should not be modified.
- EN ; -- main entry point for IBCE INSCO ID MAINT
- D EN^VALM("IBCE INSCO ID MAINT")
- Q
- ;
- HDR ; -- header code
- N PCF,PCDISP
- I '$D(IBCNS) N IBCNS S IBCNS=IBINS
- S PCF=$P($G(^DIC(36,+IBCNS,3)),U,13),PCDISP=$S(PCF="P":"(Parent)",1:"")
- S VALMHDR(1)="Insurance Co: "_$P($G(^DIC(36,+IBCNS,0)),U)_PCDISP
- Q
- ;
- INIT ; Initialize
- D CLEAN^VALM10
- I '$D(IBCNS) N IBCNS S IBCNS=IBINS
- N IBLCT
- S IBLCT=0
- ; Display the list
- D SET1(.IBLCT,"Attending/Rendering Provider Secondary ID")
- D SET1(.IBLCT,"Default ID (1500): "_$$GET1^DIQ(36,IBCNS,4.01))
- D SET1(.IBLCT,"Default ID (UB-04): "_$$GET1^DIQ(36,IBCNS,4.02))
- D SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.03))
- D SET1(.IBLCT," ")
- D SET1(.IBLCT,"Referring Provider Secondary ID")
- D SET1(.IBLCT,"Default ID (1500): "_$$GET1^DIQ(36,IBCNS,4.04))
- D SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.05))
- D SET1(.IBLCT," ")
- D SET1(.IBLCT,"Billing Provider Secondary IDs")
- D SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (1500)?: "_$$GET1^DIQ(36,IBCNS,4.06))
- D SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (UB-04)?: "_$$GET1^DIQ(36,IBCNS,4.08))
- D SET1(.IBLCT,"Transmit no Billing Provider Sec ID for the following Electronic Plan Types:")
- D LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
- F I=1:1:+$G(TAR("DILIST",0)) D
- . D SET1(.IBLCT,TAR("DILIST",1,I))
- D SET1(.IBLCT," ")
- ;JWS;IB*2.0*592;This header was left around after the 516 patch change below, not necessary
- ;D SET1(.IBLCT,"Billing Provider/Service Facility")
- ;S IBCNS4=$G(^DIC(36,+IBCNS,4))
- ; MRD;IB*2.0*516 - Marked fields 4.07, 4.11, 4.12 and 4.13 for
- ; deletion and removed all references to them.
- ;D SET1(.IBLCT,"Always use main VAMC as Billing Provider (1500)?: "_$$EXPAND^IBTRE(36,4.11,+$P(IBCNS4,U,11)))
- ;D SET1(.IBLCT,"Always use main VAMC as Billing Provider (UB-04)?: "_$$EXPAND^IBTRE(36,4.12,+$P(IBCNS4,U,12)))
- ;I $P(IBCNS4,U,11)!($P(IBCNS4,U,12)) D
- ;.D SET1(.IBLCT,"Send VA Lab/Facility IDs or Facility Data for VAMC?: "_$$EXPAND^IBTRE(36,4.07,+$P(IBCNS4,U,7)))
- ;.D SET1(.IBLCT,"Use the Billing Prov (VAMC) Name and Street Address?: "_$$EXPAND^IBTRE(36,4.13,+$P(IBCNS4,U,13)))
- ;.Q
- ;
- S VALMBG=1,VALMCNT=IBLCT
- Q
- ;
- SET1(IBLCT,TEXT,IBCT) ;
- S IBLCT=IBLCT+1 D SET^VALM10(IBLCT,TEXT)
- Q
- ;
- EXPND ;
- Q
- HELP ;
- Q
- EXIT ;
- D CLEAN^VALM10
- Q
- ;
- IDPARAM ;
- D FULL^VALM1
- N DIE,DA,DR
- I '$D(IBCNS) N IBCNS S IBCNS=IBINS
- S DIE="^DIC(36,",(DA,Y)=IBCNS,DR="[IBEDIT INS CO1]"
- I '$D(IBY) N IBY S IBY=",12,"
- D ^DIE K DIE
- K ^TMP("IBCE_PRVFAC_MAINT",$J)
- D INIT
- S VALMBCK="R"
- Q
- ;
- BILLPRVP ;
- D FULL^VALM1
- D EN^IBCEPC
- D INIT
- K ^TMP("IBCE_PRVFAC_MAINT",$J)
- S VALMBCK="R"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEPB 2936 printed Feb 18, 2025@23:38:22 Page 2
- 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
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- EN ; -- main entry point for IBCE INSCO ID MAINT
- +1 DO EN^VALM("IBCE INSCO ID MAINT")
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 NEW PCF,PCDISP
- +2 IF '$DATA(IBCNS)
- NEW IBCNS
- SET IBCNS=IBINS
- +3 SET PCF=$PIECE($GET(^DIC(36,+IBCNS,3)),U,13)
- SET PCDISP=$SELECT(PCF="P":"(Parent)",1:"")
- +4 SET VALMHDR(1)="Insurance Co: "_$PIECE($GET(^DIC(36,+IBCNS,0)),U)_PCDISP
- +5 QUIT
- +6 ;
- INIT ; Initialize
- +1 DO CLEAN^VALM10
- +2 IF '$DATA(IBCNS)
- NEW IBCNS
- SET IBCNS=IBINS
- +3 NEW IBLCT
- +4 SET IBLCT=0
- +5 ; Display the list
- +6 DO SET1(.IBLCT,"Attending/Rendering Provider Secondary ID")
- +7 DO SET1(.IBLCT,"Default ID (1500): "_$$GET1^DIQ(36,IBCNS,4.01))
- +8 DO SET1(.IBLCT,"Default ID (UB-04): "_$$GET1^DIQ(36,IBCNS,4.02))
- +9 DO SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.03))
- +10 DO SET1(.IBLCT," ")
- +11 DO SET1(.IBLCT,"Referring Provider Secondary ID")
- +12 DO SET1(.IBLCT,"Default ID (1500): "_$$GET1^DIQ(36,IBCNS,4.04))
- +13 DO SET1(.IBLCT,"Require ID on Claim: "_$$GET1^DIQ(36,IBCNS,4.05))
- +14 DO SET1(.IBLCT," ")
- +15 DO SET1(.IBLCT,"Billing Provider Secondary IDs")
- +16 DO SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (1500)?: "_$$GET1^DIQ(36,IBCNS,4.06))
- +17 DO SET1(.IBLCT,"Use Att/Rend ID as Billing Provider Sec. ID (UB-04)?: "_$$GET1^DIQ(36,IBCNS,4.08))
- +18 DO SET1(.IBLCT,"Transmit no Billing Provider Sec ID for the following Electronic Plan Types:")
- +19 DO LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
- +20 FOR I=1:1:+$GET(TAR("DILIST",0))
- Begin DoDot:1
- +21 DO SET1(.IBLCT,TAR("DILIST",1,I))
- End DoDot:1
- +22 DO SET1(.IBLCT," ")
- +23 ;JWS;IB*2.0*592;This header was left around after the 516 patch change below, not necessary
- +24 ;D SET1(.IBLCT,"Billing Provider/Service Facility")
- +25 ;S IBCNS4=$G(^DIC(36,+IBCNS,4))
- +26 ; MRD;IB*2.0*516 - Marked fields 4.07, 4.11, 4.12 and 4.13 for
- +27 ; deletion and removed all references to them.
- +28 ;D SET1(.IBLCT,"Always use main VAMC as Billing Provider (1500)?: "_$$EXPAND^IBTRE(36,4.11,+$P(IBCNS4,U,11)))
- +29 ;D SET1(.IBLCT,"Always use main VAMC as Billing Provider (UB-04)?: "_$$EXPAND^IBTRE(36,4.12,+$P(IBCNS4,U,12)))
- +30 ;I $P(IBCNS4,U,11)!($P(IBCNS4,U,12)) D
- +31 ;.D SET1(.IBLCT,"Send VA Lab/Facility IDs or Facility Data for VAMC?: "_$$EXPAND^IBTRE(36,4.07,+$P(IBCNS4,U,7)))
- +32 ;.D SET1(.IBLCT,"Use the Billing Prov (VAMC) Name and Street Address?: "_$$EXPAND^IBTRE(36,4.13,+$P(IBCNS4,U,13)))
- +33 ;.Q
- +34 ;
- +35 SET VALMBG=1
- SET VALMCNT=IBLCT
- +36 QUIT
- +37 ;
- SET1(IBLCT,TEXT,IBCT) ;
- +1 SET IBLCT=IBLCT+1
- DO SET^VALM10(IBLCT,TEXT)
- +2 QUIT
- +3 ;
- EXPND ;
- +1 QUIT
- HELP ;
- +1 QUIT
- EXIT ;
- +1 DO CLEAN^VALM10
- +2 QUIT
- +3 ;
- IDPARAM ;
- +1 DO FULL^VALM1
- +2 NEW DIE,DA,DR
- +3 IF '$DATA(IBCNS)
- NEW IBCNS
- SET IBCNS=IBINS
- +4 SET DIE="^DIC(36,"
- SET (DA,Y)=IBCNS
- SET DR="[IBEDIT INS CO1]"
- +5 IF '$DATA(IBY)
- NEW IBY
- SET IBY=",12,"
- +6 DO ^DIE
- KILL DIE
- +7 KILL ^TMP("IBCE_PRVFAC_MAINT",$JOB)
- +8 DO INIT
- +9 SET VALMBCK="R"
- +10 QUIT
- +11 ;
- BILLPRVP ;
- +1 DO FULL^VALM1
- +2 DO EN^IBCEPC
- +3 DO INIT
- +4 KILL ^TMP("IBCE_PRVFAC_MAINT",$JOB)
- +5 SET VALMBCK="R"
- +6 QUIT