ACRFEXPU.m

ACRFEXPU ;IHS/OIRM/DSD/AEF - EXPORT PROCESS CONTROL: UTILITY SUBROUTINES [ 10/27/2004   4:18 PM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,13**;NOV 05, 2001

 ;

 ;This routine contains various utility subroutines used by the

 ;ACRFEXP routines

 ;

NEXTECS(ACRD0,ACRD1)         ;EP   ;ACR*2.1*3.12

 ;----- EXTRINSIC FUNCTION - RETURNS NEXT TREASURY ECS FILE NAME

 ;

 ;      INPUT:

 ;      ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE

 ;      ACRD1 = BATCH IEN

 ;

 ;      RETURNS: NEXT TREASURY ECS FILE NAME

 ;

 ;MAKE HQ ECS FILES BEGIN WITH 1 INSTEAD OF 0 TO PREVENT CLASHING WITH

 ;AAO'S FILES ON THE SAME DISKETTE;MRS ;ALSO FOR BEMIDJI/ABERDEEN;MRS

 N I,X,Y,ACRAHN,ACRVAR

 D ^XBKVAR

 S ACRAHN=$$HOST^ACRFUTL

 S ACRVAR=1

 I ACRAHN="dpssyg" S ACRVAR=101 ;HEADQUARTERS AREA ;ACR*2.1*13.06 IM14144

 I ACRAHN="bjiao" S ACRVAR=101  ;BEMIDJI AREA      ;ACR*2.1*13.06 IM14144

 S Y=""

 S Y=$P($G(^AFSLAFP(ACRD0,1,ACRD1,2)),U,11)

 I Y']"" D

 . F I=ACRVAR:1:999 D  I '$D(^AFSLAFP(ACRD0,1,"G",X)) S Y=X Q

 .. S X=$$PAD^ACRFUTL(I,"L",3,0)_"-"_$E(DT,4,7)

 Q Y

HFS(ACRECS,ACRD0,%FILE,ACROUT)         ;EP

 ;----- CREATES AND OPENS UNIX ECS FILE

 ;

 ;      INPUT:

 ;      ACRECS = THE TREASURY ECS FILE NAME

 ;      ACRD0  = IEN OF THE FACILITY IN THE FMS SYSTEM DEFAULTS FILE

 ;

 ;      RETURNS:

 ;      %FILE  = ECS FILE NAME DEVICE NUMBER

 ;      ACROUT = QUIT CONTROLLER: 0=SUCCESSFUL, 1=UNSUCCESSFUL

 ;

 N ZISH1,ZISH2,ZISH3,X,Y

 S ACROUT=0

 ;S ZISH1=$P($G(^ACRSYS(ACRD0,402)),U,3)           ;ACR*2.1*13.06 IM14144

 S ZISH1=$$ARMSDIR^ACRFSYS(ACRD0)                  ;ACR*2.1*13.06 IM14144

 Q:ZISH1']""                                       ;ACR*2.1*13.06 IM14144

 S ZISH2=ACRECS

 S ZISH3="W"

 D HFS^ACRFUTL(ZISH1,ZISH2,ZISH3,.%FILE)

 I $G(%FILE)="" D  S ACROUT=1

 . W *7,!?5,"Unable to open host Treasury ECS file "_ACRECS

 . W !

 . H 2

 Q

ACRFEXPU  ;IHS/OIRM/DSD/AEF - EXPORT PROCESS CONTROL: UTILITY SUBROUTINES [ 10/27/2004   4:18 PM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3,13**;NOV 05, 2001

 +2       ;

 +3       ;This routine contains various utility subroutines used by the

 +4       ;ACRFEXP routines

 +5       ;

NEXTECS(ACRD0,ACRD1) ;EP   ;ACR*2.1*3.12

 +1       ;----- EXTRINSIC FUNCTION - RETURNS NEXT TREASURY ECS FILE NAME

 +2       ;

 +3       ;      INPUT:

 +4       ;      ACRD0 = FY IEN IN 1166 APPROVALS FOR PAYMENT FILE

 +5       ;      ACRD1 = BATCH IEN

 +6       ;

 +7       ;      RETURNS: NEXT TREASURY ECS FILE NAME

 +8       ;

 +9       ;MAKE HQ ECS FILES BEGIN WITH 1 INSTEAD OF 0 TO PREVENT CLASHING WITH

 +10      ;AAO'S FILES ON THE SAME DISKETTE;MRS ;ALSO FOR BEMIDJI/ABERDEEN;MRS

 +11       NEW I,X,Y,ACRAHN,ACRVAR

 +12       DO ^XBKVAR

 +13       SET ACRAHN=$$HOST^ACRFUTL

 +14       SET ACRVAR=1

 +15      ;HEADQUARTERS AREA ;ACR*2.1*13.06 IM14144

           IF ACRAHN="dpssyg"

               SET ACRVAR=101

 +16      ;BEMIDJI AREA      ;ACR*2.1*13.06 IM14144

           IF ACRAHN="bjiao"

               SET ACRVAR=101

 +17       SET Y=""

 +18       SET Y=$PIECE($GET(^AFSLAFP(ACRD0,1,ACRD1,2)),U,11)

 +19       IF Y']""

               Begin DoDot:1

 +20               FOR I=ACRVAR:1:999

                       Begin DoDot:2

 +21                       SET X=$$PAD^ACRFUTL(I,"L",3,0)_"-"_$EXTRACT(DT,4,7)

                       End DoDot:2

                       IF '$DATA(^AFSLAFP(ACRD0,1,"G",X))

                           SET Y=X

                           QUIT 

               End DoDot:1

 +22       QUIT Y

HFS(ACRECS,ACRD0,%FILE,ACROUT) ;EP

 +1       ;----- CREATES AND OPENS UNIX ECS FILE

 +2       ;

 +3       ;      INPUT:

 +4       ;      ACRECS = THE TREASURY ECS FILE NAME

 +5       ;      ACRD0  = IEN OF THE FACILITY IN THE FMS SYSTEM DEFAULTS FILE

 +6       ;

 +7       ;      RETURNS:

 +8       ;      %FILE  = ECS FILE NAME DEVICE NUMBER

 +9       ;      ACROUT = QUIT CONTROLLER: 0=SUCCESSFUL, 1=UNSUCCESSFUL

 +10      ;

 +11       NEW ZISH1,ZISH2,ZISH3,X,Y

 +12       SET ACROUT=0

 +13      ;S ZISH1=$P($G(^ACRSYS(ACRD0,402)),U,3)           ;ACR*2.1*13.06 IM14144

 +14      ;ACR*2.1*13.06 IM14144

           SET ZISH1=$$ARMSDIR^ACRFSYS(ACRD0)

 +15      ;ACR*2.1*13.06 IM14144

           IF ZISH1']""

               QUIT 

 +16       SET ZISH2=ACRECS

 +17       SET ZISH3="W"

 +18       DO HFS^ACRFUTL(ZISH1,ZISH2,ZISH3,.%FILE)

 +19       IF $GET(%FILE)=""

               Begin DoDot:1

 +20               WRITE *7,!?5,"Unable to open host Treasury ECS file "_ACRECS

 +21               WRITE !

 +22               HANG 2

               End DoDot:1

               SET ACROUT=1

 +23       QUIT