FBNPILK ;AISC/CLT, NPI lookup routine ;11 Apr 2006 3:02 PM
;;3.5;FEE BASIS;**98**;JAN 30, 1995;Build 54
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;This routine receives the IEN for the Fee Basis Vendor file (#161.2)
;and returns the NPI for that entry.
;
;This routine also performs a duplicate check to insure that only one vendor has
;a specific NPI in the FEE BASIS VENDOR file (#161.2)
;
EN(IEN) ;ENTRY POINT IF IEN IN FEE BASIS VENDOR FILE (#161.2) IS KNOWN
;The variable passed in is the IEN or DA or the entry in the FEE BASIS VENDOR
;file (#161.2). Returned will be the variable FBNPI which is the NPI
;of the entry. If the NPI is not entered the variable FBNPI will equal null
;and 10 spaces will be returned.
;
N DIC,Y,FBNPI
D:IEN=""
.S DIC="^FBAAV(",DIC(0)="AEQM",DIC("A")="ENTER VENDOR NAME: " D ^DIC G:Y'>0 XIT
.S IEN=+Y
S FBNPI=$$GET1^DIQ(161.2,IEN,41.01)
Q $S(FBNPI="":" ",1:FBNPI)
;
DUP(FBNPI) ;LOOK FOR DUPLICATE ENTRIES
;This subroutine will review the FEE BASIS VENDOR file (#161.2) cross reference NPI to
;determine if the NPI entered is unique and not assigned to another entity.
;This subroutine takes the value of the variable X from the fileman entry into file 161.2,
;field 41.01 (NPI) through the input transform using the input variable of X, assigns it
;to the variable FBNPI and performs the lookup using the "NPIHISTORY" cross reference in the file
;#161.2. If the NPI is not a duplicate entry a null value will be returned in FBRTN. If
;the variable FBRTN is a number larger than zero it means the transform lookup has failed
;and the NPI entered is a duplicate entry. This tag expects the variable DA to be the ien
;of the current entry in field name (#.01).
;The input transform is coded as follows: K:$L(X)>10!($L(X)<10)!('$$CHKDGT^XUSNPI(X))!($$DUP^FBNPILK(X)>0) X
N FBLOOP,FBRTN S FBRTN=""
S FBLOOP="" F S FBLOOP=$O(^FBAAV("NPIHISTORY",FBNPI,FBLOOP)) Q:FBLOOP="" S FBRTN=$G(FBLOOP) D:FBLOOP'=DA!('$D(^FBAAV("NPI",FBNPI,DA)))
.W !,"The NPI of ",FBNPI," is now, or was in the past, assigned to: ",?47,$P(^FBAAV(FBLOOP,0),U,1)
Q FBRTN
XIT ;EXIT AND CLEAN
K DIC,X,Y
Q " "
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBNPILK 2236 printed Oct 16, 2024@18:00:08 Page 2
FBNPILK ;AISC/CLT, NPI lookup routine ;11 Apr 2006 3:02 PM
+1 ;;3.5;FEE BASIS;**98**;JAN 30, 1995;Build 54
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;This routine receives the IEN for the Fee Basis Vendor file (#161.2)
+5 ;and returns the NPI for that entry.
+6 ;
+7 ;This routine also performs a duplicate check to insure that only one vendor has
+8 ;a specific NPI in the FEE BASIS VENDOR file (#161.2)
+9 ;
EN(IEN) ;ENTRY POINT IF IEN IN FEE BASIS VENDOR FILE (#161.2) IS KNOWN
+1 ;The variable passed in is the IEN or DA or the entry in the FEE BASIS VENDOR
+2 ;file (#161.2). Returned will be the variable FBNPI which is the NPI
+3 ;of the entry. If the NPI is not entered the variable FBNPI will equal null
+4 ;and 10 spaces will be returned.
+5 ;
+6 NEW DIC,Y,FBNPI
+7 if IEN=""
Begin DoDot:1
+8 SET DIC="^FBAAV("
SET DIC(0)="AEQM"
SET DIC("A")="ENTER VENDOR NAME: "
DO ^DIC
if Y'>0
GOTO XIT
+9 SET IEN=+Y
End DoDot:1
+10 SET FBNPI=$$GET1^DIQ(161.2,IEN,41.01)
+11 QUIT $SELECT(FBNPI="":" ",1:FBNPI)
+12 ;
DUP(FBNPI) ;LOOK FOR DUPLICATE ENTRIES
+1 ;This subroutine will review the FEE BASIS VENDOR file (#161.2) cross reference NPI to
+2 ;determine if the NPI entered is unique and not assigned to another entity.
+3 ;This subroutine takes the value of the variable X from the fileman entry into file 161.2,
+4 ;field 41.01 (NPI) through the input transform using the input variable of X, assigns it
+5 ;to the variable FBNPI and performs the lookup using the "NPIHISTORY" cross reference in the file
+6 ;#161.2. If the NPI is not a duplicate entry a null value will be returned in FBRTN. If
+7 ;the variable FBRTN is a number larger than zero it means the transform lookup has failed
+8 ;and the NPI entered is a duplicate entry. This tag expects the variable DA to be the ien
+9 ;of the current entry in field name (#.01).
+10 ;The input transform is coded as follows: K:$L(X)>10!($L(X)<10)!('$$CHKDGT^XUSNPI(X))!($$DUP^FBNPILK(X)>0) X
+11 NEW FBLOOP,FBRTN
SET FBRTN=""
+12 SET FBLOOP=""
FOR
SET FBLOOP=$ORDER(^FBAAV("NPIHISTORY",FBNPI,FBLOOP))
if FBLOOP=""
QUIT
SET FBRTN=$GET(FBLOOP)
if FBLOOP'=DA!('$DATA(^FBAAV("NPI",FBNPI,DA)))
Begin DoDot:1
+13 WRITE !,"The NPI of ",FBNPI," is now, or was in the past, assigned to: ",?47,$PIECE(^FBAAV(FBLOOP,0),U,1)
End DoDot:1
+14 QUIT FBRTN
XIT ;EXIT AND CLEAN
+1 KILL DIC,X,Y
+2 QUIT " "
