| [613] | 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 "          "
 | 
|---|