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