source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSC1.m

IBCNSC1 ;ALB/NLR - IBCNS INSURANCE COMPANY ;23-MAR-93
 ;;2.0;INTEGRATED BILLING;**62,137,232,291,320,348,349**;21-MAR-94;Build 46
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
% G EN^IBCNSC
 ;
AI ; -- (In)Activate Company
 D FULL^VALM1 W !!
 I '$D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) D SORRY G EXIT
 D ^IBCNSC2
 G EXIT
CC ; -- Change Insurance Company
 D FULL^VALM1 W !!
 S IBCNS1=IBCNS K IBCNS D INSCO^IBCNSC
 I '$D(IBCNS) S IBCNS=IBCNS1
 K IBCNS1,VALMQUIT
 G EXIT
EA ; -- Billing,Claims,Appeals,Inquiry,Telephone,Main,Remarks,Synonyms
 D FULL^VALM1
 ;
 ; IB*2*320 - check key for associate company action
 I $G(IBY)=",13,",'$$KCHK^XUSRB("IB EDI INSURANCE EDIT") D  G EXIT
 . W !!?5,"You must hold the IB EDI INSURANCE EDIT key to access this option."
 . D PAUSE^VALM1
 . Q
 ;
 W !!
 D MAIN
 ;
 ; -- was company deleted
 I '$D(^DIC(36,IBCNS)) W !!,"<DELETED>",!! S VALMQUIT="" Q
 ;
EXIT ;
 D HDR^IBCNSC,BLD^IBCNSC
 S VALMBCK="R"
 Q
MAIN ; -- Call edit template
 N IBEDIKEY,Z
 L +^DIC(36,+IBCNS):5 I '$T D LOCKED^IBTRCD1 G MAINQ
 I $G(IBY)=",12," D FACID
 F Z=1,2,4,9,13,14 S IBEDIKEY(Z)=$P($G(^DIC(36,+IBCNS,3)),U,Z)   ; save EDI data fields
 I $G(IBY)'=",12," N DIE,DA,DR S DIE="^DIC(36,",(DA,Y)=IBCNS,DR="[IBEDIT INS CO1]" D ^DIE K DIE I $D(Y) S IB("^")=1
 I $G(IBY)=",12," D EDITID^IBCEP(+IBCNS)
 I $F(",6,13,",$G(IBY)) D PARENT^IBCNSC02(+IBCNS)   ; parent/child management
 L -^DIC(36,+IBCNS)
MAINQ Q
 ;
FACID ; -- Edit facility ids
 D FACID^IBCEP2B(+IBCNS,"E")
 Q
 ;
SORRY ; -- can't inactivate, don't have key
 W !!,"You do not have access to Inactivate entries.  See your application coordinator.",! D PAUSE^VALM1
 Q
PRESCR ;
 N OFFSET,START,IBCNS18,IBADD
 S IBCNS18=$$ADDRESS^IBCNSC0(IBCNS,.18,11)
 S START=34,OFFSET=2
 D SET^IBCNSP(START,OFFSET+19," Prescription Claims Office Information ",IORVON,IORVOFF)
 D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS18,"^",7),0)),"^",1))
 D SET^IBCNSP(START+2,OFFSET,"       Street: "_$P(IBCNS18,"^",1))
 D SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$P(IBCNS18,"^",2))
 ; D SET^IBCNSP(START+4,OFFSET,"Claim Off. ID: "_$P(IBCNS18,"^",11))
 N OFFSET S OFFSET=45
 D SET^IBCNSP(START+1,OFFSET,"     Street 3: "_$P(IBCNS18,"^",3)) S IBADD=1
 D SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$E($P(IBCNS18,"^",4),1,15)_$S($P(IBCNS18,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS18,"^",5),0)),"^",2)_" "_$E($P(IBCNS18,"^",6),1,5))
 D SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$P(IBCNS18,"^",8))
 D SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$P(IBCNS18,"^",9))
 Q
 ;
PROVID N OFFSET,START,IBCNS4,IBCNS3,IBDISP,Z,LINE
 S START=$O(^TMP("IBCNSC",$J,""),-1)+1
 S (IB1ST("PROVID"),LINE)=START
 S OFFSET=2,IBCNS4=$G(^DIC(36,IBCNS,4)),IBCNS3=$G(^(3))
 ;       
 D SET^IBCNSP(LINE,OFFSET+25,"Provider IDs",IORVON,IORVOFF)
 N OFFSET
 S LINE=LINE+1,OFFSET=1
 D SET^IBCNSP(LINE,OFFSET,"Billing Provider Secondary ID")
 ;
 N Z,Z0,Z1,IBS,I,DIV,FT,CU,CUF,DIVISION,FORMTYPE,PIDT
 S Z=0 F  S Z=$O(^IBA(355.92,"B",+IBCNS,Z)) Q:'Z  D
 . S Z0=$G(^IBA(355.92,Z,0))
 . Q:'$P(Z0,U,6)!($P(Z0,U,7)="")  ; Quit if no provider id or id type
 . Q:'($P(Z0,U,8)="E")
 . S IBS(+$P(Z0,U,5),+$P(Z0,U,3),+$P(Z0,U,4))=$P(Z0,U,6)_U_$P(Z0,U,7)
 ;
 S DIV="" F  S DIV=$O(IBS(DIV)) Q:DIV=""  D
 . S DIVISION=$$DIV^IBCEP7(DIV)
 . S CU="",CUF=0 F  S CU=$O(IBS(DIV,CU)) Q:CU=""  D
 .. S FT="" F  S FT=$O(IBS(DIV,CU,FT)) Q:FT=""  D
 ... S FORMTYPE=$S(FT=1:"UB-04",FT=2:"1500",1:"UNKNOWN")
 ... S LINE=LINE+1
 ... I 'CUF,+CU S CUF=1 S TEXT=$P(DIVISION,"/")_" Care Units :",OFFSET=5 D SET^IBCNSP(LINE,OFFSET,TEXT) S LINE=LINE+1
 ... I CU=0 S TEXT=DIVISION_"/"_FORMTYPE_": "_$$GET1^DIQ(355.97,$P(IBS(DIV,CU,FT),U),.03,"E")_" "_$P(IBS(DIV,CU,FT),U,2),OFFSET=2
 ... I +CU S TEXT=$$EXPAND^IBTRE(355.92,.03,CU)_"/"_FORMTYPE_": "_$$GET1^DIQ(355.97,$P(IBS(DIV,CU,FT),U),.03,"E")_" "_$P(IBS(DIV,CU,FT),U,2),OFFSET=5
 ... D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S LINE=LINE+1 D SET^IBCNSP(LINE,2," ")
 ;
 K IBS
 S OFFSET=1,LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,"Additional Billing Provider Secondary IDs")
 S Z=0 F  S Z=$O(^IBA(355.92,"B",+IBCNS,Z)) Q:'Z  D
 . S Z0=$G(^IBA(355.92,Z,0))
 . Q:'$P(Z0,U,6)!($P(Z0,U,7)="")  ; Quit if no provider id or id type
 . Q:'($P(Z0,U,8)="A")
 . ; IBS(DIVISION,FORMTYPE,IDTYPE)=ID
 . S IBS(+$P(Z0,U,5),+$P(Z0,U,4),+$P(Z0,U,6))=$P(Z0,U,7)
 ;
 S DIVISION=$$DIV^IBCEP7(0)
 S DIV="" F  S DIV=$O(IBS(DIV)) Q:DIV=""  D
 . S FT="" F  S FT=$O(IBS(DIV,FT)) Q:FT=""  D
 .. S FORMTYPE=$S(FT=1:"UB-04",FT=2:"1500",1:"UNKNOWN")
 .. S TEXT=DIVISION_"/"_FORMTYPE_": "
 .. S LINE=LINE+1,OFFSET=2
 .. D SET^IBCNSP(LINE,OFFSET,TEXT)
 .. S PIDT="" F  S PIDT=$O(IBS(DIV,FT,PIDT)) Q:PIDT=""  D
 ... S LINE=LINE+1
 ... S TEXT=$$GET1^DIQ(355.97,PIDT,.03,"E")_" "_IBS(DIV,FT,PIDT),OFFSET=5
 ... D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S LINE=LINE+1 D SET^IBCNSP(LINE,2," ")
 ;
 K IBS
 S OFFSET=1,LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,"VA-Laboratory or Facility Secondary IDs")
 S Z=0 F  S Z=$O(^IBA(355.92,"B",+IBCNS,Z)) Q:'Z  D
 . S Z0=$G(^IBA(355.92,Z,0))
 . Q:'$P(Z0,U,6)!($P(Z0,U,7)="")  ; Quit if no provider id or id type
 . Q:'($P(Z0,U,8)="LF")
 . ; IBS(DIVISION,FORMTYPE,IDTYPE)=ID
 . S IBS(+$P(Z0,U,5),+$P(Z0,U,4),+$P(Z0,U,6))=$P(Z0,U,7)
 ;
 S DIVISION=$$DIV^IBCEP7(0)
 S DIV="" F  S DIV=$O(IBS(DIV)) Q:DIV=""  D
 . S FT="" F  S FT=$O(IBS(DIV,FT)) Q:FT=""  D
 .. S FORMTYPE=$S(FT=1:"UB-04",FT=2:"1500",1:"UNKNOWN")
 .. S TEXT=DIVISION_"/"_FORMTYPE_": "
 .. S LINE=LINE+1,OFFSET=2
 .. D SET^IBCNSP(LINE,OFFSET,TEXT)
 .. S PIDT="" F  S PIDT=$O(IBS(DIV,FT,PIDT)) Q:PIDT=""  D
 ... S LINE=LINE+1
 ... ;S TEXT=$$EXPAND^IBTRE(355.92,.06,PIDT)_" "_IBS(DIV,FT,PIDT),OFFSET=5
 ... S TEXT=$$GET1^DIQ(355.97,PIDT,.03,"E")_" "_IBS(DIV,FT,PIDT),OFFSET=5
 ... D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 ;
 S LINE=LINE+1 D SET^IBCNSP(LINE,2," ")
 S LINE=LINE+1 D SET^IBCNSP(LINE,2," ")
 S OFFSET=2
 S LINE=LINE+1 D SET^IBCNSP(LINE,OFFSET+25,"ID Parameters",IORVON,IORVOFF)
 ;
 S IBCNS4=$G(^DIC(36,IBCNS,4)),IBCNS3=$G(^(3)),OFFSET=1
 S TEXT="Attending/Rendering Provider Secondary ID Qualifier (1500): "_$$EXPAND^IBTRE(36,4.01,+$P(IBCNS4,U))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Attending/Rendering Provider Secondary ID Qualifier (UB-04): "_$$EXPAND^IBTRE(36,4.02,+$P(IBCNS4,U,2))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Attending/Rendering Secondary ID Requirement: "_$$EXPAND^IBTRE(36,4.03,+$P(IBCNS4,U,3))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Referring Provider Secondary ID Qualifier (1500): "_$$EXPAND^IBTRE(36,4.04,+$P(IBCNS4,U,4))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Referring Provider Secondary ID Requirement: "_$$EXPAND^IBTRE(36,4.05,+$P(IBCNS4,U,5))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Use Att/Rend ID as Billing Provider Sec. ID (1500): "_$$EXPAND^IBTRE(36,4.06,+$P(IBCNS4,U,6))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Use Att/Rend ID as Billing Provider Sec. ID (UB-04): "_$$EXPAND^IBTRE(36,4.08,+$P(IBCNS4,U,8))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Send VA Lab/Facility IDs or Facility Data for VAMC?: "_$$EXPAND^IBTRE(36,4.07,+$P(IBCNS4,U,7))
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S TEXT="Transmit no Billing Provider Sec. ID for the Electronic Plan Types: "
 S LINE=LINE+1
 D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 N TAR,ERR,IBCT
 D LIST^DIC(36.013,","_IBCNS_",",".01",,10,,,,,,"TAR","ERR")
 F IBCT=1:1:+$G(TAR("DILIST",0)) D
 . S TEXT=TAR("DILIST",1,IBCT)
 . S LINE=LINE+1
 . D SET^IBCNSP(LINE,OFFSET,TEXT)
 ;
 S LINE=LINE+1 D SET^IBCNSP(LINE,2," ")
 S LINE=LINE+1 D SET^IBCNSP(LINE,2," ")
 Q
 ;       
INSDEF(IBINS,IBPTYP) ; Returns the default id # for an ins co, if possible
 N X
 S X=""
 I IBINS,IBPTYP S X=$P($G(^IBA(355.91,+$O(^IBA(355.91,"AC",IBINS,IBPTYP,"*N/A*","")),0)),U,7)
 Q X