source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEUT8.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1IBCNEUT8 ;DAOU/AM - IIV MISC. UTILITIES ;12-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine includes subroutines originally included in IBCNEUT3
6 ; and referenced by IBCNEUT3 and IBCNEUT4.
7 ;
8 ; INSIEN returns an array of matching insurance IENs based upon the
9 ; provided Insurance Name.
10 ;
11 ; FINDPAY returns the National IDs for all provided active insurance
12 ; companies.
13 ;
14 ; ERROR returns the IEN of the symbol mnemonice passed to it and updates
15 ; an array of items to display, if passed.
16 ;
17 ; Can't be called from the top
18 Q
19 ;
20 ;
21INSIEN(INSNAME,INSIEN) ; Subroutine to find all ins co IENs
22 ; matching a given ins co name
23 ; Input parameter: INSNAME - Ins co name to find IENs for
24 ; Output parameter: INSIEN - array of ins co IENs that
25 ; match the passed ins co name, passed by reference
26 ; If the array is defined at the time this subroutine is called,
27 ; then it will add to the data that pre-exists in the array
28 ;
29 N NAME
30 ; Loop through the ins co names starting with a space (" ")
31 ; looking for matching names
32 S NAME=" " F S NAME=$O(^DIC(36,"B",NAME)) Q:$E(NAME,1)'=" " D
33 . ;I $$TRIM^XLFSTR(NAME)=INSNAME M INSIEN=^DIC(36,"B",NAME)
34 . I $$TRIM^XLFSTR(NAME)=INSNAME D
35 . . N %X,%Y
36 . . S %X="^DIC(36,""B"",NAME,"
37 . . S %Y="INSIEN("
38 . . I $D(^DIC(36,"B",NAME))#10=1 S INSIEN=^DIC(36,"B",NAME)
39 . . D %XY^%RCR K %X,%Y
40 ;
41 ; Retrieve the ins co names from the Ins Buffer
42 ; starting with the entry prior to the ins co name in
43 ; the Buffer and look for ins co name matches
44 S NAME=$O(^DIC(36,"B",INSNAME),-1)
45 F S NAME=$O(^DIC(36,"B",NAME)) Q:$E(NAME,1,$L(INSNAME))'=INSNAME D
46 . ;I $$TRIM^XLFSTR(NAME)=INSNAME M INSIEN=^DIC(36,"B",NAME)
47 . I $$TRIM^XLFSTR(NAME)=INSNAME D
48 . . N %X,%Y
49 . . S %X="^DIC(36,""B"",NAME,"
50 . . S %Y="INSIEN("
51 . . I $D(^DIC(36,"B",NAME))#10=1 S INSIEN=^DIC(36,"B",NAME)
52 . . D %XY^%RCR K %X,%Y
53 ;
54 Q
55 ;
56FINDPAY(INSIEN,PAYID) ; Find National IDs for an array of ins co IENs
57 ; Input parameter: INSIEN - Array of ins co IENs
58 ; Output parameter: PAYID - Array of National IDs
59 N PAYIEN,IEN
60 S IEN=0 F S IEN=$O(INSIEN(IEN)) Q:'IEN D
61 . ; Discard INACTIVE ins companies from the array
62 . I '$$ACTIVE^IBCNEUT4(IEN) K INSIEN(IEN) Q
63 . ; Retrieve the Payer IEN for this ins co IEN
64 . S PAYIEN=$P($G(^DIC(36,IEN,3)),U,10)
65 . I 'PAYIEN Q
66 . ; Retrieve the National ID for this ins co IEN
67 . S PAYID=$P($G(^IBE(365.12,PAYIEN,0)),U,2)
68 . I PAYID'="" S PAYID(PAYID)=IEN
69 Q
70 ;
71ERROR(ERRCODE,ERRTEXT,MULTI) ; Function to return the IEN of the Symbol
72 ; file entry and error text - also adds error data to ARRAY
73 ; Input parameters: ERRCODE - Symbol mnemonic ("B1", "B2", etc)
74 ; ERRTEXT - Optional additional error text
75 ; MULTI - Optional array of items to display
76 ; Output parameters: ARRAY - Updated by this function
77 ; Function value - Symbol IEN
78 NEW %,DISYS,DIW,DIWI,DIWT,DIWTC,DIWX,DN,ERRARR,I,SYMIEN,Z
79 ; If an optional array of items to display was passed in, add it
80 I $G(ERRTEXT)'="",$D(MULTI) S ERRTEXT=$$MULTNAME^IBCNEUT4(ERRTEXT,.MULTI)
81 S SYMIEN=$$FIND1^DIC(365.15,,"X",$G(ERRCODE))
82 ; call an IB utility to parse ERRTEXT into lines of acceptable length
83 D FSTRNG^IBJU1($G(ERRTEXT),70,.ERRARR)
84 ; Update the line counter in the error array
85 S ARRAY=$G(ARRAY)+1
86 ; Merge the error text array returned by the IB utility in
87 M ARRAY(ARRAY)=ERRARR
88 ; Reset the error-specific node of the error array to follow the
89 ; published input/output parameter format
90 S ARRAY(ARRAY)=SYMIEN_U_ERRARR
91 Q SYMIEN
92 ;
Note: See TracBrowser for help on using the repository browser.