source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSNPIXU.m@ 738

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

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1XUSNPIXU ;OAK_BP/DLS - NPI Extract Utilities ;
2 ;;8.0;KERNEL;**438,453**; Jul 10, 1995;Build 36
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7 ; NPI Extract Functions and Utilities
8 ;
9BCBSID ; This sub-routine is designed to create a string for each Blue Cross/Blue Shield Insurance Company,
10 ; including the Ins Co name and an array of BCBS ID's (the ID's separated by a semi-colon sub-delimiter).
11 ;
12 ; Input Parameter - N/A
13 ;
14 ; System Parameters
15 ; S ==> ";" (Semi-Colon Sub-Delimiter)
16 ; U ==> "^"
17 ;
18 ; Variables
19 ; INSCO - Insurance Company IEN
20 ; INSTYP - Insurance Company Type
21 ; INSNAM - Insurance Company Name
22 ; INSHPR - Hospital Provider Number
23 ; INSPPR - Professional Provider Number
24 ; IBILP - IB Insurance Co Level Billing Provider IEN
25 ; IBILF - IB Insurance Co Level Billing Facility IEN
26 ; IBDFPID - Default BCBS Provider #
27 ; IBILPID - IB Insurance Co Level Billing Provider ID
28 ; IBILFID - IB Insurance Co Level Billing Facility ID
29 ; IDSTR - Local BCBS ID String, placed into ^TMP when complete.
30 ;
31 K ^TMP("XUSNPIXU",$J)
32 N INSCO,INSTYP,INSNAM,INSHPR,INSPPR,IBILP,IBILF,IBILPID,IBILFID,IDSTR,P,S
33 ;
34 S S=";"
35 ;
36 ; Loop through the Insurance Co file.
37 S INSCO=0
38 F S INSCO=$O(^DIC(36,INSCO)) Q:'INSCO D
39 . S IDSTR=""
40 . S INSTYP=$$GET1^DIQ(36,INSCO_",",.13)
41 . ;
42 . ; If the Insurance Co type is not Blue Cross or Blue Shield, QUIT and move on to the next one.
43 . I '((INSTYP="BLUE CROSS")!(INSTYP="BLUE SHIELD")) Q
44 . ;
45 . ; Get Insurance Company Name.
46 . S INSNAM=$$GET1^DIQ(36,INSCO_",",.01)
47 . ;
48 . ; Get the IB Insurance Co Level Billing Prov ID's.
49 . S IBILP=0
50 . F S IBILP=$O(^IBA(355.92,"B",INSCO,IBILP)) Q:'IBILP D
51 . . S IBILPID=$$GET1^DIQ(355.92,IBILP_",",.07)
52 . . D ADDID(.IDSTR,IBILPID)
53 . ;
54 . ; Get the IB Insurance Co Level Billing Facility ID's.
55 . S IBILF=0
56 . F S IBILF=$O(^IBA(355.91,"B",INSCO,IBILF)) Q:'IBILF D
57 . . S IBILFID=$$GET1^DIQ(355.91,IBILF_",",.07)
58 . . D ADDID(.IDSTR,IBILFID)
59 . ;
60 . ; Remove trailing semi-colon and place local ID string into ^TMP.
61 . I $E(IDSTR,$L(IDSTR))=";" S IDSTR=$E(IDSTR,1,$L(IDSTR)-1)
62 . I IDSTR'="" S ^TMP("XUSNPIXU",$J,INSCO)=INSNAM_U_IDSTR
63 Q
64 ;
65 ;
66ADDID(IDSTRING,ID) ; Append BCBS ID to local ID string, using ";" as the sub-delimiter. Called from BCBSID
67 ;
68 ; Input Parameters
69 ; IDSTRING - Local variable ID string, passed from BCBSID
70 ; ID - ID to be appended to IDSTRING, passed from BCBSID
71 ;
72 I '$D(ID)!('$D(IDSTRING)) Q
73 I ID'="",IDSTRING'[ID S IDSTRING=IDSTRING_ID_S
74 Q
75 ;
76PRACID(NPIEN,INS) ; Get Practitioner IDs
77 ;
78 ; Output Parameter
79 ; INS - Array-Passed by Reference
80 N BIEN,PRAC,A
81 K INS
82 S BIEN=NPIEN_";VA(200,"
83 S PRAC=""
84 F S PRAC=$O(^IBA(355.9,"B",BIEN,PRAC)) Q:'PRAC D
85 . S A=$$BCBSTR(PRAC) I A'="" S INS(A)=""
86 Q
87 ;
88NNVAID(NPIEN,INS) ; Get Non-VA Provider IDS
89 ;
90 ; Output Parameter
91 ; INS - Array-Passed by Reference
92 N BIEN,PRAC,A
93 K INS
94 S BIEN=NPIEN_";IBA(355.93,"
95 S PRAC=""
96 F S PRAC=$O(^IBA(355.9,"B",BIEN,PRAC)) Q:'PRAC D
97 . S A=$$BCBSTR(PRAC) I A'="" S INS(A)=""
98 Q
99 ;
100INSTID(INSARRAY) ; Get Institution IDs
101 ;
102 ; Output Parameter
103 ; INSARRAY - Array-Passed by Reference
104 N INS,A
105 K INSARRAY
106 S INS=0
107 ; 12/13/2007 DLS - Change array structure from INSARRAY(A)="" to INSARRAY($P(A,U,1))=$P(A,U,2)
108 F S INS=$O(^TMP("XUSNPIXU",$J,INS)) Q:INS="" D
109 . S A=^TMP("XUSNPIXU",$J,INS)
110 . S INSARRAY($P(A,U,1))=$P(A,U,2)
111 Q
112 ;
113 ;
114BCBSTR(PRACIEN) ; Receive an IB Billing Practitioner Provider IEN and return the string of ID's already created.
115 ;
116 ; Input Parameters
117 ; PRACIEN - Practitioner Ins. Co. file IEN - Linked to Provider and passed from NPI Extract.
118 ;
119 ; System Parameters
120 ; S ==> ";" (Semi-Colon Sub-Delimiter)
121 ; Variables
122 ; INSCO - Insurance Company IEN
123 ; PRVID - Provider ID for the specific Insurance Company. This is added on to the ID string stored in TMP.
124 ;
125 ; Get the Ins Co IEN
126 N INSCO,PRVID,P,S
127 S S=";"
128 S INSCO=$$GET1^DIQ(355.9,PRACIEN_",",.02,"I")
129 ;
130 ; Quit if this is NOT a Blue Cross/Blue Shield Insurance Company.
131 I $G(^TMP("XUSNPIXU",$J,+INSCO))="" Q ""
132 ;
133 ; Get the Practitioner ID for this specific Insurance Company. (commented out for now)
134 S PRVID=$$GET1^DIQ(355.9,PRACIEN_",",.07)
135 ;
136 ; If PRVID is NOT null AND the ID is NOT already in the string AND
137 ; (If the string DOES NOT end with a "^", return the ID string with the sub-delimiter and PRVID appended) OR
138 ; (If the string DOES end with a "^", return the ID string with only PRVID appended.)
139 I PRVID'="",((^TMP("XUSNPIXU",$J,INSCO)'["^PRVID;")!(^TMP("XUSNPIXU",$J,INSCO)'[";PRVID;")) D Q ^TMP("XUSNPIXU",$J,INSCO)_PRVID
140 . I $E($L(^TMP("XUSNPIXU",$J,INSCO)))'=U S PRVID=S_PRVID
141 . Q
142 ;
143 ; If nothing needs changing, return the string unchanged.
144 Q ^TMP("XUSNPIXU",$J,INSCO)
145 ;
146INIT ;Initialize ^XTMP
147 K ^XTMP("XUSNPIX1")
148 K ^XTMP("XUSNPIX2")
149 K ^XTMP("XUSNPIX1NV")
150 K ^XTMP("XUSNPIX2NV")
151 K ^XTMP("XUSNPIXT")
152 ;
Note: See TracBrowser for help on using the repository browser.