AFSLEMLU.m

AFSLEMLU ;IHS/OIRM/DSD/JDM - PERSON SELECTION;  [ 09/27/2005  12:53 PM ]

 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005

 ;Lookup for person selection

 ;D ^XBCLS

 K AFSLPFND,AFSLPNOD,AFSLPZRO

 I '$D(AFSLVND) S AFSLVND="?"

 S AFSLPFND="XX"

DOIT ;

 S DIC="^VA(200,",DIC(0)="ENZQA",X=AFSLVND

 I '$D(AFSLTMPL) G SKST

 S DIC(0)="ZNM"

SKST ;

 I $D(AFSLTMPL) G SKST2

 I AFSLVND'["?" S DIC(0)="EZMNQ"

SKST2 ;

 D ^DIC

 I Y<1 S AFSLPFND="XX" G FINI

 S AFSLPNOD=$P(Y,U,1),AFSLPFND=Y(0,0),AFSLPZRO=Y(0)

 I ($P(Y,U,1)="")!('$D(^VA(200,AFSLPNOD,.11)))!($P(^VA(200,AFSLPNOD,1),U,9)="") S AFSLERR=33 Q

 S AFSLPADD=^VA(200,AFSLPNOD,.11),AFSLXX1=$P(^VA(200,AFSLPNOD,1),U,9)

 ;S AFSLPNAM=$P(^VA(200,AFSLPNOD,0),U,1)  ;ACR*2.1*19.02 IM16848

 S AFSLPNAM=$$NAME2^ACRFUTL1(AFSLPNOD)  ;ACR*2.1*19.02 IM16848

FINI ;

 QUIT

AFSLEMLU  ;IHS/OIRM/DSD/JDM - PERSON SELECTION;  [ 09/27/2005  12:53 PM ]

 +1       ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005

 +2       ;Lookup for person selection

 +3       ;D ^XBCLS

 +4        KILL AFSLPFND,AFSLPNOD,AFSLPZRO

 +5        IF '$DATA(AFSLVND)

               SET AFSLVND="?"

 +6        SET AFSLPFND="XX"

DOIT      ;

 +1        SET DIC="^VA(200,"

           SET DIC(0)="ENZQA"

           SET X=AFSLVND

 +2        IF '$DATA(AFSLTMPL)

               GOTO SKST

 +3        SET DIC(0)="ZNM"

SKST      ;

 +1        IF $DATA(AFSLTMPL)

               GOTO SKST2

 +2        IF AFSLVND'["?"

               SET DIC(0)="EZMNQ"

SKST2     ;

 +1        DO ^DIC

 +2        IF Y<1

               SET AFSLPFND="XX"

               GOTO FINI

 +3        SET AFSLPNOD=$PIECE(Y,U,1)

           SET AFSLPFND=Y(0,0)

           SET AFSLPZRO=Y(0)

 +4        IF ($PIECE(Y,U,1)="")!('$DATA(^VA(200,AFSLPNOD,.11)))!($PIECE(^VA(200,AFSLPNOD,1),U,9)="")

               SET AFSLERR=33

               QUIT 

 +5        SET AFSLPADD=^VA(200,AFSLPNOD,.11)

           SET AFSLXX1=$PIECE(^VA(200,AFSLPNOD,1),U,9)

 +6       ;S AFSLPNAM=$P(^VA(200,AFSLPNOD,0),U,1)  ;ACR*2.1*19.02 IM16848

 +7       ;ACR*2.1*19.02 IM16848

           SET AFSLPNAM=$$NAME2^ACRFUTL1(AFSLPNOD)

FINI      ;

 +1        QUIT