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

IBCNEUT8.m

Go to the documentation of this file. 
  1. IBCNEUT8 ;DAOU/AM - eIV MISC. UTILITIES ;12-JUN-2002
  1.  ;;2.0;INTEGRATED BILLING;**184,416**;21-MAR-94;Build 58
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; This routine includes subroutines originally included in IBCNEUT3
  1.  ; and referenced by IBCNEUT3 and IBCNEUT4.
  1.  ;
  1.  ; INSIEN returns an array of matching insurance IENs based upon the
  1.  ; provided Insurance Name.
  1.  ;
  1.  ; FINDPAY returns the National IDs for all provided active insurance
  1.  ; companies.
  1.  ;
  1.  ; ERROR returns the IEN of the symbol mnemonice passed to it and updates
  1.  ; an array of items to display, if passed.
  1.  ; 
  1.  ; Can't be called from the top
  1.  Q
  1.  ;
  1.  ;
  1. INSIEN(INSNAME,INSIEN) ; Subroutine to find all ins co IENs
  1.  ; matching a given ins co name
  1.  ; Input parameter: INSNAME - Ins co name to find IENs for
  1.  ; Output parameter: INSIEN - array of ins co IENs that
  1.  ;   match the passed ins co name, passed by reference
  1.  ;   If the array is defined at the time this subroutine is called,
  1.  ;   then it will add to the data that pre-exists in the array
  1.  ;
  1.  N NAME
  1.  ; Loop through the ins co names starting with a space (" ")
  1.  ; looking for matching names
  1.  S NAME=" " F  S NAME=$O(^DIC(36,"B",NAME)) Q:$E(NAME,1)'=" "  D
  1.  . I $$TRIM^XLFSTR(NAME)=INSNAME M INSIEN=^DIC(36,"B",NAME)
  1.  . Q
  1.  ;
  1.  ; Retrieve the ins co names from the Ins Buffer
  1.  ; starting with the entry prior to the ins co name in
  1.  ; the Buffer and look for ins co name matches
  1.  S NAME=$O(^DIC(36,"B",INSNAME),-1)
  1.  F  S NAME=$O(^DIC(36,"B",NAME)) Q:$E(NAME,1,$L(INSNAME))'=INSNAME  D
  1.  . I $$TRIM^XLFSTR(NAME)=INSNAME M INSIEN=^DIC(36,"B",NAME)
  1.  . Q
  1.  ;
  1.  Q
  1.  ;
  1. FINDPAY(INSIEN,PAYID) ; Find National IDs for an array of ins co IENs
  1.  ; Input parameter: INSIEN - Array of ins co IENs
  1.  ; Output parameter: PAYID - Array of National IDs
  1.  N PAYIEN,IEN
  1.  S IEN=0 F  S IEN=$O(INSIEN(IEN)) Q:'IEN  D
  1.  . ; Discard INACTIVE ins companies from the array
  1.  . I '$$ACTIVE^IBCNEUT4(IEN) K INSIEN(IEN) Q
  1.  . ; Retrieve the Payer IEN for this ins co IEN
  1.  . S PAYIEN=$P($G(^DIC(36,IEN,3)),U,10)
  1.  . I 'PAYIEN Q
  1.  . ; Retrieve the National ID for this ins co IEN
  1.  . S PAYID=$P($G(^IBE(365.12,PAYIEN,0)),U,2)
  1.  . I PAYID'="" S PAYID(PAYID)=IEN
  1.  Q
  1.  ;
  1. ERROR(ERRCODE,ERRTEXT,MULTI) ; Function to return the IEN of the Symbol
  1.  ; file entry and error text - also adds error data to ARRAY
  1.  ; Input parameters: ERRCODE - Symbol mnemonic ("B1", "B2", etc)
  1.  ;                   ERRTEXT - Optional additional error text
  1.  ;                   MULTI   - Optional array of items to display
  1.  ; Output parameters: ARRAY - Updated by this function
  1.  ;     Function value - Symbol IEN
  1.  NEW %,DISYS,DIW,DIWI,DIWT,DIWTC,DIWX,DN,ERRARR,I,SYMIEN,Z
  1.  ; If an optional array of items to display was passed in, add it
  1.  I $G(ERRTEXT)'="",$D(MULTI) S ERRTEXT=$$MULTNAME^IBCNEUT4(ERRTEXT,.MULTI)
  1.  S SYMIEN=$$FIND1^DIC(365.15,,"X",$G(ERRCODE))
  1.  ; call an IB utility to parse ERRTEXT into lines of acceptable length
  1.  D FSTRNG^IBJU1($G(ERRTEXT),70,.ERRARR)
  1.  ; Update the line counter in the error array
  1.  S ARRAY=$G(ARRAY)+1
  1.  ; Merge the error text array returned by the IB utility in
  1.  M ARRAY(ARRAY)=ERRARR
  1.  ; Reset the error-specific node of the error array to follow the
  1.  ; published input/output parameter format
  1.  S ARRAY(ARRAY)=SYMIEN_U_ERRARR
  1.  Q SYMIEN
  1.  ;