- 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 Feb 18, 2025@23:25:44 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 " "
