| 1 | FBNPILK ;AISC/CLT, NPI lookup routine ;11 Apr 2006  3:02 PM | 
|---|
| 2 | ;;3.5;FEE BASIS;**98**;JAN 30, 1995;Build 54 | 
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | ;This routine receives the IEN for the Fee Basis Vendor file (#161.2) | 
|---|
| 6 | ;and returns the NPI for that entry. | 
|---|
| 7 | ; | 
|---|
| 8 | ;This routine also performs a duplicate check to insure that only one vendor has | 
|---|
| 9 | ;a specific NPI in the FEE BASIS VENDOR file (#161.2) | 
|---|
| 10 | ; | 
|---|
| 11 | EN(IEN) ;ENTRY POINT IF IEN IN FEE BASIS VENDOR FILE (#161.2) IS KNOWN | 
|---|
| 12 | ;The variable passed in is the IEN or DA or the entry in the FEE BASIS VENDOR | 
|---|
| 13 | ;file (#161.2).  Returned will be the variable FBNPI which is the NPI | 
|---|
| 14 | ;of the entry.  If the NPI is not entered the variable FBNPI will equal null | 
|---|
| 15 | ;and 10 spaces will be returned. | 
|---|
| 16 | ; | 
|---|
| 17 | N DIC,Y,FBNPI | 
|---|
| 18 | D:IEN="" | 
|---|
| 19 | .S DIC="^FBAAV(",DIC(0)="AEQM",DIC("A")="ENTER VENDOR NAME: " D ^DIC G:Y'>0 XIT | 
|---|
| 20 | .S IEN=+Y | 
|---|
| 21 | S FBNPI=$$GET1^DIQ(161.2,IEN,41.01) | 
|---|
| 22 | Q $S(FBNPI="":"          ",1:FBNPI) | 
|---|
| 23 | ; | 
|---|
| 24 | DUP(FBNPI) ;LOOK FOR DUPLICATE ENTRIES | 
|---|
| 25 | ;This subroutine will review the FEE BASIS VENDOR file (#161.2) cross reference NPI to | 
|---|
| 26 | ;determine if the NPI entered is unique and not assigned to another entity. | 
|---|
| 27 | ;This subroutine takes the value of the variable X from the fileman entry into file 161.2, | 
|---|
| 28 | ;field 41.01 (NPI) through the input transform using the input variable of X, assigns it | 
|---|
| 29 | ;to the variable FBNPI and performs the lookup using the "NPIHISTORY" cross reference in the file | 
|---|
| 30 | ;#161.2.  If the NPI is not a duplicate entry a null value will be returned in FBRTN.  If | 
|---|
| 31 | ;the variable FBRTN is a number larger than zero it means the transform lookup has failed | 
|---|
| 32 | ;and the NPI entered is a duplicate entry.  This tag expects the variable DA to be the ien | 
|---|
| 33 | ;of the current entry in field name (#.01). | 
|---|
| 34 | ;The input transform is coded as follows: K:$L(X)>10!($L(X)<10)!('$$CHKDGT^XUSNPI(X))!($$DUP^FBNPILK(X)>0) X | 
|---|
| 35 | N FBLOOP,FBRTN S FBRTN="" | 
|---|
| 36 | S FBLOOP="" F  S FBLOOP=$O(^FBAAV("NPIHISTORY",FBNPI,FBLOOP)) Q:FBLOOP=""  S FBRTN=$G(FBLOOP) D:FBLOOP'=DA!('$D(^FBAAV("NPI",FBNPI,DA))) | 
|---|
| 37 | .W !,"The NPI of ",FBNPI," is now, or was in the past, assigned to: ",?47,$P(^FBAAV(FBLOOP,0),U,1) | 
|---|
| 38 | Q FBRTN | 
|---|
| 39 | XIT ;EXIT AND CLEAN | 
|---|
| 40 | K DIC,X,Y | 
|---|
| 41 | Q "          " | 
|---|