153 lines
5.0 KiB
Mathematica
153 lines
5.0 KiB
Mathematica
XUSNPIXU ;OAK_BP/DLS - NPI Extract Utilities ;
|
|
;;8.0;KERNEL;**438,453**; Jul 10, 1995;Build 36
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
Q
|
|
;
|
|
; NPI Extract Functions and Utilities
|
|
;
|
|
BCBSID ; This sub-routine is designed to create a string for each Blue Cross/Blue Shield Insurance Company,
|
|
; including the Ins Co name and an array of BCBS ID's (the ID's separated by a semi-colon sub-delimiter).
|
|
;
|
|
; Input Parameter - N/A
|
|
;
|
|
; System Parameters
|
|
; S ==> ";" (Semi-Colon Sub-Delimiter)
|
|
; U ==> "^"
|
|
;
|
|
; Variables
|
|
; INSCO - Insurance Company IEN
|
|
; INSTYP - Insurance Company Type
|
|
; INSNAM - Insurance Company Name
|
|
; INSHPR - Hospital Provider Number
|
|
; INSPPR - Professional Provider Number
|
|
; IBILP - IB Insurance Co Level Billing Provider IEN
|
|
; IBILF - IB Insurance Co Level Billing Facility IEN
|
|
; IBDFPID - Default BCBS Provider #
|
|
; IBILPID - IB Insurance Co Level Billing Provider ID
|
|
; IBILFID - IB Insurance Co Level Billing Facility ID
|
|
; IDSTR - Local BCBS ID String, placed into ^TMP when complete.
|
|
;
|
|
K ^TMP("XUSNPIXU",$J)
|
|
N INSCO,INSTYP,INSNAM,INSHPR,INSPPR,IBILP,IBILF,IBILPID,IBILFID,IDSTR,P,S
|
|
;
|
|
S S=";"
|
|
;
|
|
; Loop through the Insurance Co file.
|
|
S INSCO=0
|
|
F S INSCO=$O(^DIC(36,INSCO)) Q:'INSCO D
|
|
. S IDSTR=""
|
|
. S INSTYP=$$GET1^DIQ(36,INSCO_",",.13)
|
|
. ;
|
|
. ; If the Insurance Co type is not Blue Cross or Blue Shield, QUIT and move on to the next one.
|
|
. I '((INSTYP="BLUE CROSS")!(INSTYP="BLUE SHIELD")) Q
|
|
. ;
|
|
. ; Get Insurance Company Name.
|
|
. S INSNAM=$$GET1^DIQ(36,INSCO_",",.01)
|
|
. ;
|
|
. ; Get the IB Insurance Co Level Billing Prov ID's.
|
|
. S IBILP=0
|
|
. F S IBILP=$O(^IBA(355.92,"B",INSCO,IBILP)) Q:'IBILP D
|
|
. . S IBILPID=$$GET1^DIQ(355.92,IBILP_",",.07)
|
|
. . D ADDID(.IDSTR,IBILPID)
|
|
. ;
|
|
. ; Get the IB Insurance Co Level Billing Facility ID's.
|
|
. S IBILF=0
|
|
. F S IBILF=$O(^IBA(355.91,"B",INSCO,IBILF)) Q:'IBILF D
|
|
. . S IBILFID=$$GET1^DIQ(355.91,IBILF_",",.07)
|
|
. . D ADDID(.IDSTR,IBILFID)
|
|
. ;
|
|
. ; Remove trailing semi-colon and place local ID string into ^TMP.
|
|
. I $E(IDSTR,$L(IDSTR))=";" S IDSTR=$E(IDSTR,1,$L(IDSTR)-1)
|
|
. I IDSTR'="" S ^TMP("XUSNPIXU",$J,INSCO)=INSNAM_U_IDSTR
|
|
Q
|
|
;
|
|
;
|
|
ADDID(IDSTRING,ID) ; Append BCBS ID to local ID string, using ";" as the sub-delimiter. Called from BCBSID
|
|
;
|
|
; Input Parameters
|
|
; IDSTRING - Local variable ID string, passed from BCBSID
|
|
; ID - ID to be appended to IDSTRING, passed from BCBSID
|
|
;
|
|
I '$D(ID)!('$D(IDSTRING)) Q
|
|
I ID'="",IDSTRING'[ID S IDSTRING=IDSTRING_ID_S
|
|
Q
|
|
;
|
|
PRACID(NPIEN,INS) ; Get Practitioner IDs
|
|
;
|
|
; Output Parameter
|
|
; INS - Array-Passed by Reference
|
|
N BIEN,PRAC,A
|
|
K INS
|
|
S BIEN=NPIEN_";VA(200,"
|
|
S PRAC=""
|
|
F S PRAC=$O(^IBA(355.9,"B",BIEN,PRAC)) Q:'PRAC D
|
|
. S A=$$BCBSTR(PRAC) I A'="" S INS(A)=""
|
|
Q
|
|
;
|
|
NNVAID(NPIEN,INS) ; Get Non-VA Provider IDS
|
|
;
|
|
; Output Parameter
|
|
; INS - Array-Passed by Reference
|
|
N BIEN,PRAC,A
|
|
K INS
|
|
S BIEN=NPIEN_";IBA(355.93,"
|
|
S PRAC=""
|
|
F S PRAC=$O(^IBA(355.9,"B",BIEN,PRAC)) Q:'PRAC D
|
|
. S A=$$BCBSTR(PRAC) I A'="" S INS(A)=""
|
|
Q
|
|
;
|
|
INSTID(INSARRAY) ; Get Institution IDs
|
|
;
|
|
; Output Parameter
|
|
; INSARRAY - Array-Passed by Reference
|
|
N INS,A
|
|
K INSARRAY
|
|
S INS=0
|
|
; 12/13/2007 DLS - Change array structure from INSARRAY(A)="" to INSARRAY($P(A,U,1))=$P(A,U,2)
|
|
F S INS=$O(^TMP("XUSNPIXU",$J,INS)) Q:INS="" D
|
|
. S A=^TMP("XUSNPIXU",$J,INS)
|
|
. S INSARRAY($P(A,U,1))=$P(A,U,2)
|
|
Q
|
|
;
|
|
;
|
|
BCBSTR(PRACIEN) ; Receive an IB Billing Practitioner Provider IEN and return the string of ID's already created.
|
|
;
|
|
; Input Parameters
|
|
; PRACIEN - Practitioner Ins. Co. file IEN - Linked to Provider and passed from NPI Extract.
|
|
;
|
|
; System Parameters
|
|
; S ==> ";" (Semi-Colon Sub-Delimiter)
|
|
; Variables
|
|
; INSCO - Insurance Company IEN
|
|
; PRVID - Provider ID for the specific Insurance Company. This is added on to the ID string stored in TMP.
|
|
;
|
|
; Get the Ins Co IEN
|
|
N INSCO,PRVID,P,S
|
|
S S=";"
|
|
S INSCO=$$GET1^DIQ(355.9,PRACIEN_",",.02,"I")
|
|
;
|
|
; Quit if this is NOT a Blue Cross/Blue Shield Insurance Company.
|
|
I $G(^TMP("XUSNPIXU",$J,+INSCO))="" Q ""
|
|
;
|
|
; Get the Practitioner ID for this specific Insurance Company. (commented out for now)
|
|
S PRVID=$$GET1^DIQ(355.9,PRACIEN_",",.07)
|
|
;
|
|
; If PRVID is NOT null AND the ID is NOT already in the string AND
|
|
; (If the string DOES NOT end with a "^", return the ID string with the sub-delimiter and PRVID appended) OR
|
|
; (If the string DOES end with a "^", return the ID string with only PRVID appended.)
|
|
I PRVID'="",((^TMP("XUSNPIXU",$J,INSCO)'["^PRVID;")!(^TMP("XUSNPIXU",$J,INSCO)'[";PRVID;")) D Q ^TMP("XUSNPIXU",$J,INSCO)_PRVID
|
|
. I $E($L(^TMP("XUSNPIXU",$J,INSCO)))'=U S PRVID=S_PRVID
|
|
. Q
|
|
;
|
|
; If nothing needs changing, return the string unchanged.
|
|
Q ^TMP("XUSNPIXU",$J,INSCO)
|
|
;
|
|
INIT ;Initialize ^XTMP
|
|
K ^XTMP("XUSNPIX1")
|
|
K ^XTMP("XUSNPIX2")
|
|
K ^XTMP("XUSNPIX1NV")
|
|
K ^XTMP("XUSNPIX2NV")
|
|
K ^XTMP("XUSNPIXT")
|
|
;
|