source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBNPILK.m@ 841

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1FBNPILK ;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 ;
11EN(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 ;
24DUP(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
39XIT ;EXIT AND CLEAN
40 K DIC,X,Y
41 Q " "
Note: See TracBrowser for help on using the repository browser.