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

IBCNSC.m

Go to the documentation of this file. 
  1. IBCNSC ;ALB/NLR - INSURANCE COMPANY EDIT ;6/1/05 9:42am
  1.  ;;2.0;INTEGRATED BILLING;**46,137,184,276,320,371,400,488,547,592,668,752,763**;21-MAR-94;Build 29
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;also used for IA #4694
  1.  ;
  1. EN ; -- main entry point for IBCNS INSURANCE COMPANY, IBCNS VIEW INS CO
  1.  NEW IB1ST
  1.  K IBFASTXT,VALMQUIT,VALMEVL,XQORS,^TMP("XQORS",$J),IBCNS
  1.  S IBCHANGE="OKAY"
  1.  I '$G(IBVIEW) D EN^VALM("IBCNS INSURANCE COMPANY") G ENQ
  1.  D EN^VALM("IBCNS VIEW INS CO")
  1. ENQ Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)="Insurance Company Information for: "_$E($P(^DIC(36,IBCNS,0),"^"),1,30)
  1.  S VALMHDR(2)="Type of Company: "_$E($P($G(^IBE(355.2,+$P($G(^DIC(36,+IBCNS,0)),"^",13),0)),"^"),1,20)_"                     Currently "_$S(+($P($G(^DIC(36,+IBCNS,0)),"^",5)):"Inactive",1:"Active")
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  K VALMQUIT
  1.  S VALMCNT=0,VALMBG=1
  1.  I '$D(IBCNS) D INSCO Q:$D(VALMQUIT)
  1.  D BLD,HDR
  1.  Q
  1. BLD ; -- list builder
  1.  ;WCJ;IB*2.0*547
  1.  ;NEW BLNKI
  1.  NEW BLNKI,IBACMAX ; new variable set in PARAM section and needed throughout for display
  1.  ;
  1.  K ^TMP("IBCNSC",$J)
  1.  D KILL^VALM10()    ; delete all video attributes
  1.  F BLNKI=1:1:62 D BLANK(.BLNKI)     ; 62 blank lines to start with
  1.  D PARAM^IBCNSC01      ; billing parameters
  1.  D MAIN^IBCNSC01       ; main mailing address
  1.  D CLAIMS1^IBCNSC0     ; inpatient claims office
  1.  D CLAIMS2^IBCNSC0     ; outpatient claims office
  1.  D PRESCR^IBCNSC1      ; prescription claims office
  1.  D APPEALS             ; appeals office
  1.  D INQUIRY             ; inquiry office
  1.  D DENTAL              ; Dental Claims Office        KDM US2487 IB*2.0*592
  1.  D DISP^IBCNSC02       ; parent/child associations (ESG 11/3/05)
  1.  D PROVID^IBCNSC1      ; provider IDs
  1.  D PAYER^IBCNSC01      ; payer/payer apps (ESG 7/29/02 IIV project)
  1.  D REMARKS^IBCNSC01    ; remarks
  1.  D SYN^IBCNSC01        ; synonyms
  1.  S VALMCNT=+$O(^TMP("IBCNSC",$J,""),-1)
  1.  Q
  1.  ;
  1. APPEALS ;
  1.  N OFFSET,START,IBCNS14,IBADD
  1.  ;
  1.  ;WCJ;IB*2.0*547;Call new API
  1.  ;S IBCNS14=$$ADDRESS^IBCNSC0(IBCNS,.14,7)
  1.  ;
  1.  ;WCJ;IB*2.0*547
  1.  ;S START=48,OFFSET=2
  1.  S START=49+(2*$G(IBACMAX)),OFFSET=2
  1. APPEALAD ; KDM US2487 IB*2.0*592  call in tag from IBCNSI 
  1.  S IBCNS14=$$ADD2^IBCNSC0(IBCNS,.14,7)  ;KDM moved to be able to call into from IBCNSI
  1.  D SET^IBCNSP(START,OFFSET+25," Appeals Office Information ",IORVON,IORVOFF)
  1.  ;IA# 5292
  1.  D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS14,"^",7),0)),"^",1))
  1.  D SET^IBCNSP(START+2,OFFSET,"       Street: "_$P(IBCNS14,"^",1))
  1.  D SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$P(IBCNS14,"^",2))
  1.  N OFFSET S OFFSET=45
  1.  D SET^IBCNSP(START+1,OFFSET,"     Street 3: "_$P(IBCNS14,"^",3)) S IBADD=1
  1.  ;IA# 650
  1.  D SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$E($P(IBCNS14,"^",4),1,15)_$S($P(IBCNS14,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS14,"^",5),0)),"^",2)_" "_$E($P(IBCNS14,"^",6),1,5))
  1.  D SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$P(IBCNS14,"^",8))
  1.  D SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$P(IBCNS14,"^",9))
  1.  Q
  1.  ;
  1. INQUIRY ;
  1.  ;
  1.  N OFFSET,START,IBCNS15,IBADD
  1.  ;
  1.  ;WCJ;IB*2.0*547;Call new API
  1.  ;S IBCNS15=$$ADDRESS^IBCNSC0(IBCNS,.15,8)
  1.  ;
  1.  ;WCJ;IB*2.0*547
  1.  ;S START=55,OFFSET=2
  1.  S START=56+(2*$G(IBACMAX)),OFFSET=2
  1. INQAD ; KDM US2487 IB*2.0*592  call in tag from IBCNSI 
  1.  S IBCNS15=$$ADD2^IBCNSC0(IBCNS,.15,8)  ;KDM moved to be able to call into from IBCNSI
  1.  D SET^IBCNSP(START,OFFSET+25," Inquiry Office Information ",IORVON,IORVOFF)
  1.  ;IA# 5292
  1.  D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS15,"^",7),0)),"^",1))
  1.  D SET^IBCNSP(START+2,OFFSET,"       Street: "_$P(IBCNS15,"^"))
  1.  D SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$P(IBCNS15,"^",2))
  1.  N OFFSET S OFFSET=45
  1.  D SET^IBCNSP(START+1,OFFSET,"     Street 3: "_$P(IBCNS15,"^",3)) S IBADD=1
  1.  ;IA# 650
  1.  D SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$E($P(IBCNS15,"^",4),1,15)_$S($P(IBCNS15,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS15,"^",5),0)),"^",2)_" "_$E($P(IBCNS15,"^",6),1,5))
  1.  D SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$P(IBCNS15,"^",8))
  1.  D SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$P(IBCNS15,"^",9))
  1.  Q
  1.  ; 
  1. DENTAL ; Display Dental Claims office information
  1.  ;KDM US2487 IB*2.0*592
  1.  ;
  1.  N OFFSET,START,IBCNS19,IBADD
  1.  S START=63+(2*$G(IBACMAX)),OFFSET=2
  1. DENTALAD ; KDM US2487 IB*2.0*592  call in tag from IBCNSI 
  1.  D SET^IBCNSP(START,OFFSET+20," Dental Claims Office Information ",IORVON,IORVOFF)
  1.  ;
  1.  S IBCNS19=$$ADD2^IBCNSC0(IBCNS,.19,6)
  1.  ;IA# 5292
  1.  D SET^IBCNSP(START+1,OFFSET," Company Name: "_$P($G(^DIC(36,+$P(IBCNS19,"^",7),0)),"^",1))
  1.  D SET^IBCNSP(START+2,OFFSET,"       Street: "_$P(IBCNS19,"^",1))
  1.  D SET^IBCNSP(START+3,OFFSET,"     Street 2: "_$P(IBCNS19,"^",2))
  1.  S OFFSET=45,IBADD=1
  1.  ;IA# 650
  1.  D SET^IBCNSP(START+1+IBADD,OFFSET,"   City/State: "_$E($P(IBCNS19,"^",4),1,15)_$S($P(IBCNS19,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCNS19,"^",5),0)),"^",2)_" "_$E($P(IBCNS19,"^",6),1,5))
  1.  D SET^IBCNSP(START+2+IBADD,OFFSET,"        Phone: "_$P(IBCNS19,"^",8))
  1.  D SET^IBCNSP(START+3+IBADD,OFFSET,"          Fax: "_$P(IBCNS19,"^",9))
  1.  ;/vd-IB*2.0*668 The following 2 lines were added to fix pre-mature ending of display.
  1.  D BLANK(START+4+IBADD)
  1.  D BLANK(START+5+IBADD)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K VALMQUIT,IBCNS,IBCHANGE,IBFASTXT
  1.  D CLEAN^VALM10
  1.  Q
  1.  ;
  1. INSCO ; -- select insurance company
  1.  ;JWS;IB*2.0*592;new of DR
  1.  ;IB*752/TAZ - Restructured to call new utility for case insensitive lookups
  1.  NEW ARRAY,DLAYGO,DIC,DR,X,Y,DTOUT,DUOUT,IBCNS3,SCR
  1.  I '$D(IBCNS) D  G:$D(VALMQUIT) INSCOQ G:'$D(IBCNS) INSCO
  1.  . S SCR="I '$G(^DIC(36,+Y,5))"
  1.  . D INSOCAS^IBCNINSC(.ARRAY,1,,.SCR)
  1.  . I $D(ARRAY)>1 S IBCNS=$O(ARRAY("")) Q
  1.  . I ARRAY="^"!(ARRAY="") S VALMQUIT=1 Q
  1.  . S IBCNS=ARRAY
  1.  . ; Quit if lookup was successful
  1.  . ;I IBCNS Q  ;IB*763/DTG removed in order to continue to add ins co. if failing the $D check above
  1.  . ; lookup was not successful, quit if View only.
  1.  . I $G(IBVIEW) W !,"Insurance Company not found." K IBCNS Q
  1.  . ; Add new entry in upper case only
  1.  . S DIC="^DIC(36,",DIC(0)="BEQZL",DLAYGO=36
  1.  . ;Force upper case before calling ^DIC before 
  1.  . S X=$$UP^XLFSTR(ARRAY)
  1.  . D ^DIC K DIC
  1.  . I +Y<0 W !,"Insurance Company was not added." K IBCNS Q
  1.  . S IBCNS=+Y
  1.  . ;  /Beginning of IB*2.0*488 (vd)
  1.  . I +IBCNS I $P($G(^DIC(36,+IBCNS,3)),"^",1)="" D     ; Set default for EDI=Transmit? to YES-LIVE
  1.  .. S DR="3.01////1",DIE="^DIC(36,",DA=IBCNS D ^DIE K DIE
  1.  .. ;  /End of IB*2.0*488 (vd)
  1.  I $G(IBCNS)<1 K IBCNS S VALMQUIT="" G INSCOQ
  1. INSCOQ ;
  1.  K DIC
  1.  Q
  1.  ;
  1. BLANK(LINE) ; -- Build blank line
  1.  D SET^VALM10(.LINE,$J("",80))
  1.  Q
  1.  ;
  1. EDIKEY() ; input transform code to determine if user is allowed to edit
  1.  ; certain fields in the insurance company file
  1.  NEW OK S OK=0
  1.  I $$KCHK^XUSRB("IB EDI INSURANCE EDIT") S OK=1 G EDIKEYX
  1.  D EN^DDIOL("You must hold the IB EDI INSURANCE EDIT security key to edit this field.",,"!!")
  1.  D EN^DDIOL("",,"!!?5")
  1. EDIKEYX ;
  1.  Q OK
  1.  ;
  1. DUPQUAL(IBCNS,QUAL,FIELD) ; input transform to make sure that the same qualifier is not used twice for
  1.  ; payer secondary IDs.  There are two sets of fields in file 36 that can not be duplicated.
  1.  ; 6.01 EDI INST SECONDARY ID QUAL(1) can not be the same as 6.03 EDI INST SECONDARY ID QUAL(2)
  1.  ; 6.05 EDI PROF SECONDARY ID QUAL(1) can not be the same as 6.07 EDI PROF SECONDARY ID QUAL(2)
  1.  ; 
  1.  ; Input:
  1.  ; IBCNS is the insurance company internal number
  1.  ; QUAL  is the internal code of the value being input.
  1.  ; FIELD is the field it is being compare with.
  1.  ;
  1.  ; Returns:
  1.  ; TRUE/1 if they are the same (duplicate)
  1.  ; FALSE/0 if they are not
  1.  ;
  1.  Q:$G(QUAL)="" 0  ; should not happen because this is invoked as an input transform
  1.  Q:'+$G(IBCNS) 1  ; stop from editing through fileman
  1.  N DUP
  1.  S DUP=$$GET1^DIQ(36,+$G(IBCNS)_",",+$G(FIELD),"I")
  1.  D CLEAN^DILF
  1.  Q QUAL=DUP
  1.  ;
  1.  ;WCJ;IB*2.0*547
  1. ALLOWED(IBAC) ;  input transform to make sure that Administrative Contractor is set up in the site parameters.
  1.  ; it will be set up for either commercial or medicare.  Since the type is defined my the plan and we are at a higher
  1.  ; level in the Insurance Company, we have to allow both.
  1.  ; called from ^DD(36.015,.01,0) and ^DD(36.016,.01,0)
  1.  ;
  1.  ;3/17/2016 - A decision was made to limit which type is allowed by using the TYPE OF COVERAGE field. (TAZ)
  1.  ;
  1.  ;
  1.  ; Input:
  1.  ; IBAC  is the internal code of the value being input.
  1.  ;
  1.  ; Returns:
  1.  ; TRUE/1 if allowed (set up in site parameters)
  1.  ; FALSE/0 if they are not
  1.  ; 
  1.  Q:$D(^IBE(350.9,1,$S($$GET1^DIQ(36,IBCNS_",","TYPE OF COVERAGE")="MEDICARE":81,1:82),"B",IBAC)) 1
  1.  Q 0
  1.  ;
  1.  ; WCJ;IB*2.0*547
  1.  ; This is to clean up any extraneous nodes if a user entered an alternate ID type, but not an actual ID.
  1. CLEANIDS(INSIEN) ;
  1.  ; INSIEN=Insurance Company IEN
  1.  ;
  1.  N NODE,LOOP,DATA,CLEANUP
  1.  F NODE=15,16 D
  1.  .S LOOP=0 F  S LOOP=$O(^DIC(36,INSIEN,NODE,LOOP))  Q:'+LOOP  S DATA=$G(^(LOOP,0)) I DATA]"",$P(DATA,U,2)="" D
  1.  ..N DIK,DA
  1.  ..S DA=LOOP,DA(1)=INSIEN
  1.  ..S DIK="^DIC(36,"_INSIEN_","_NODE_","
  1.  ..D ^DIK
  1.  ..S CLEANUP=1
  1.  I $G(CLEANUP) D
  1.  . N DIR
  1.  . S DIR("A",1)="Payer ID Types without corresponding ID# were deleted."
  1.  . S DIR(0)="EA",DIR("A")="PRESS ENTER TO CONTINUE "
  1.  . D ^DIR
  1.  .Q
  1.  Q