Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AFSLPILU

AFSLPILU.m

Go to the documentation of this file.
  1. AFSLPILU ;IHS/OIRM/DSD/JDM - PAYEE ID LOOKUP; [ 09/27/2005 12:53 PM ]
  1. ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
  1. ;Lookup for payee identification
  1. K AFSLPFND,AFSLPNOD
  1. S AFSLPNOD=0,AFSLPNXT=0
  1. FIND ;
  1. I AFSLPID="" S Y=-1 G FINI
  1. I '$O(^VA(200,AFSLPNOD)) S Y=-1 G FINI
  1. S AFSLPNXT=$O(^VA(200,AFSLPNOD))
  1. I $D(^VA(200,AFSLPNXT,1)) S AFSLPFND=$P(^VA(200,AFSLPNXT,1),U,9)
  1. I AFSLPFND=AFSLPID G DOIT
  1. S AFSLPNOD=AFSLPNXT G FIND
  1. DOIT ;
  1. ;S AFSLPNOD=AFSLPNXT,AFSLPADD=^VA(200,AFSLPNOD,.11),AFSLPNAM=$P(^VA(200,AFSLPNOD,0),U,1)
  1. S AFSLPNOD=AFSLPNXT
  1. I '$D(^VA(200,AFSLPNOD,.11)) S AFSLPADD="^^^^^",Y=-1 G FINI
  1. S AFSLPADD=^VA(200,AFSLPNOD,.11)
  1. ;S AFSLPNAM=$P(^VA(200,AFSLPNOD,0),U,1) ;ACR*2.1*19.02 IM16848
  1. S AFSLPNAM=$$NAME2^ACRFUTL1(AFSLPNOD) ;ACR*2.1*19.02 IM16848
  1. FINI ;
  1. K AFSLPNXT
  1. QUIT