ACRFUTL2.m

ACRFUTL2 ;IHS/OIRM/DSD/AEF - VARIOUS UTILITY SUBROUTINES [ 11/04/2002  8:22 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,6,T**;NOV 05, 2001

 ;

 ;*** TESTING - MRS *** NEW ROUTINE ACR*2.1*6.04

 ;

NOTA(X) ;----- ALLOW/DISALLOW TRAVEL ADVANCE ; ACR*2.1*5.11

 ;      USED BY INPUT TRANSFORM ON FMS DOCUMENT FIELD TRAVEL ADVANCE

 ;      ALLOWED

 ;

 ;      INPUT:

 ;      X  =  DOCUMENT IEN

 ;

 ;      OUTPUT:

 ;      0  =  TRAVEL ADVANCE NOT ALLOWED

 ;      1  =  TRAVEL ADVANCE ALLOWED

 ;

 N ACRCAN,Y

 S Y=1

 ;

 ;----- IF ATM AUTHORIZED, NO TRAVEL ADVANCE ALLOWED

 I $P($G(^ACRDOC(X,"TO")),U,22) S Y=0

 ;

 ;----- DON'T ALLOW TRAVEL ADVANCE FOR HEADQUARTERS EAST

 S ACRCAN=$P($G(^ACRDOC(X,"REQ")),U,10)

 I ACRCAN S ACRCAN=$P($G(^AUTTCAN(ACRCAN,0)),U)

 ;I $E(ACRCAN,1,3)="J94" S Y=0 ;COMMENTED OUT TO UNBLOCK TRAVEL ADVANCES AT HQE

 ;

 Q Y

 ;

NAME(X) ;EP -- RETURNS EXTERNAL PERSON FILE 200 NAME ; ACR*2.1*5.15

 ;

 ;      X  =  PERSON FILE 200 IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^VA(200,X,0)),U)

 Q Y

 ;Begin new sub-routine *** TESTING - MRS *** ACR*2.1*6.04

FYFUN(X) ;EP -- RETURNS FISCAL YEAR OF FUNDS

 ;

 ;      X  =  FMS DEPARTMENT ACCOUNT IEN

 ;

 N Y

 S Y=""

 I X S Y=$P($G(^ACRLOCB(X,"DT")),U)

 Q Y

 ;End new sub-routine *** TESTING - MRS *** ACR*2.1*6.04

ACRFUTL2  ;IHS/OIRM/DSD/AEF - VARIOUS UTILITY SUBROUTINES [ 11/04/2002  8:22 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5,6,T**;NOV 05, 2001

 +2       ;

 +3       ;*** TESTING - MRS *** NEW ROUTINE ACR*2.1*6.04

 +4       ;

NOTA(X)   ;----- ALLOW/DISALLOW TRAVEL ADVANCE ; ACR*2.1*5.11

 +1       ;      USED BY INPUT TRANSFORM ON FMS DOCUMENT FIELD TRAVEL ADVANCE

 +2       ;      ALLOWED

 +3       ;

 +4       ;      INPUT:

 +5       ;      X  =  DOCUMENT IEN

 +6       ;

 +7       ;      OUTPUT:

 +8       ;      0  =  TRAVEL ADVANCE NOT ALLOWED

 +9       ;      1  =  TRAVEL ADVANCE ALLOWED

 +10      ;

 +11       NEW ACRCAN,Y

 +12       SET Y=1

 +13      ;

 +14      ;----- IF ATM AUTHORIZED, NO TRAVEL ADVANCE ALLOWED

 +15       IF $PIECE($GET(^ACRDOC(X,"TO")),U,22)

               SET Y=0

 +16      ;

 +17      ;----- DON'T ALLOW TRAVEL ADVANCE FOR HEADQUARTERS EAST

 +18       SET ACRCAN=$PIECE($GET(^ACRDOC(X,"REQ")),U,10)

 +19       IF ACRCAN

               SET ACRCAN=$PIECE($GET(^AUTTCAN(ACRCAN,0)),U)

 +20      ;I $E(ACRCAN,1,3)="J94" S Y=0 ;COMMENTED OUT TO UNBLOCK TRAVEL ADVANCES AT HQE

 +21      ;

 +22       QUIT Y

 +23      ;

NAME(X)   ;EP -- RETURNS EXTERNAL PERSON FILE 200 NAME ; ACR*2.1*5.15

 +1       ;

 +2       ;      X  =  PERSON FILE 200 IEN

 +3       ;

 +4        NEW Y

 +5        SET Y=""

 +6        IF X

               SET Y=$PIECE($GET(^VA(200,X,0)),U)

 +7        QUIT Y

 +8       ;Begin new sub-routine *** TESTING - MRS *** ACR*2.1*6.04

FYFUN(X)  ;EP -- RETURNS FISCAL YEAR OF FUNDS

 +1       ;

 +2       ;      X  =  FMS DEPARTMENT ACCOUNT IEN

 +3       ;

 +4        NEW Y

 +5        SET Y=""

 +6        IF X

               SET Y=$PIECE($GET(^ACRLOCB(X,"DT")),U)

 +7        QUIT Y

 +8       ;End new sub-routine *** TESTING - MRS *** ACR*2.1*6.04