AFSLDKG ;IHS/OIRM/DSD/JDM,HJT - GEN TREAS DISKETTE FROM UNIX FILE; [ 10/27/2004 4:21 PM ]
;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;
;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9
;Modified for Y2K Compliance 1/11/99HJT
;Generates treasury diskette format file from unix export file
;CHANGES PER THL 090397
S %H=$H
D YX^%DTC
S AFSLMMDD=$E(X,4,7)
LISTFLES ;
;I $D(AFSLTRFL) G READIN1 ;ACR*2.1*13.06 IM14144
;S AFSLEXFN=AFSLFTXN ;ACR*2.1*13.06 IM14144
;S AFSEXFN="/usr/spool/afsdata/"_AFSLEXFN ;ACR*2.1*13.06 IM14144
;G READIN2 ;Never gets to the following lines ;ACR*2.1*13.06 IM14144
;D ^XBCLS ;ACR*2.1*13.06 IM14144
;W !?20,"IHS 1166/APPROVALS FOR PAYMENT SYSTEM",! ;ACR*2.1*13.06 IM14144
;W !?10,"1166 AFP FILES AVAILABLE FOR GENERATION OF TREAS DISKETTE",!!;ACR*2.1*13.06 IM14144
;S AFSLCMD="cd /usr/spool/afsdata;ls -l afslut* |more";ACR*2.1*13.06 IM14144
;D HOSTCMD^AFSLCKZC ;ACR*2.1*13.06 IM14144
N ARMSDIR ;ACR*2.1*13.06 IM14144
S ARMSDIR=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*13.06 IM14144
I ARMSDIR="" G FINI ;ACR*2.1*13.06 IM14144
I $D(AFSLTRFL) G READIN1
S AFSLEXFN=AFSLFTXN
S AFSEXFN=ARMSDIR_AFSLEXFN ;ACR*2.1*13.06 IM14144
G READIN2
READIN1 ;
S DIR("A")="FILENAME TO USE"
S DIR(0)="F^11:14"
D ^DIR
I X["^"!(X="") G FINI
I X["?" W !!,"Enter filename (i.e., afsluta.93105)" G READIN1
S AFSLXPFX=$E(X,1,6)
I AFSLXPFX'="afslut" D G READIN1
.W !!,"FILENAME: ",X," IS INVALID FOR THIS OPTION."
.H 2
.W *7
S AFSLEXFN=X
;S AFSEXFN="/usr/spool/afsdata/"_X ;ACR*2.1*13.06 IM14144
;I $D(AFSLTRFL)
S AFSEXFN=ARMSDIR_X ;ACR*2.1*13.06 IM14144
READIN2 ;
S AFSLDEV=IO(0)
G READIN3
S %ZIS("A")="Device to List ECS File Contents? "
D ^%ZIS
S AFSLDEV=IO
READIN3 ;
S AFSLSDEV=IO(0)
I '$D(AFSLTRFL) S AFSLFY=AFSLSFY G READIN4
S DIR("A")="TREASURY SCHEDULE FY"
S DIR(0)="N^1000:9999:0"
U AFSLSDEV
D ^DIR
I X["^"!(X="") G FINI
I X["?" W !!,"Enter the 4 digit fiscal year of Treasury schedule contained in the file" G READIN3
S AFSLFY=X
READIN4 ;
I '$D(AFSLTRFL) S AFSLSH11="0000"_AFSLSCHX,AFSLSCDX=AFSLSH11,X=0 G GETLST
S DIR("A")="TREASURY SCHED#"
S DIR(0)="F^6:6"
U AFSLSDEV
D ^DIR
I X["^"!(X="") G FINI
I X["?" W !!,"Enter a 6 character Treasury Schedule#" G READIN4
S AFSLSH11="0000"_X
S AFSLSCDX=AFSLSH11
S X="0"
GETLST ;
K AFSLTRFL
;I '$O(^AFSLDKGL(X)) G DOITX
S X=$O(^AFSLDKGL(99999999),-1)
;G GETLST
DOITX ;
W !,"PLEASE WAIT.."
I X="0" S AFSLNXDK="001" G CONT
S AFSLLSDK=$P(^AFSLDKGL(X,0),U,5)
I $P(AFSLLSDK,"-",2)=AFSLMMDD S AFSLNXDK=$P(AFSLLSDK,"-",1),AFSLNXDK=AFSLNXDK+1 G CONT
I $P(AFSLLSDK,"-",2)'=AFSLMMDD S AFSLNXDK=1 G CONT
CONT ;
S AFSLSYMT=0
S AFSLNXDK=$E("000",1,3-$L(AFSLNXDK))_AFSLNXDK
I '$D(AFSLXFLG) D ASKTYP
I AFSLXFLG'=1&(AFSLXFLG'=2)&(AFSLXFLG'=3) G FINI
;I AFSLXFLG,123[AFSLXFLG D ; ACR*2.1*13.02 IM13574
;.D:AFSLXFLG=1 ^AFSLDKG2 ; ACR*2.1*13.02 IM13574
;.D:AFSLXFLG=2 ^AFSLACH ; ACR*2.1*13.02 IM13574
;.D:AFSLXFLG=3 ^AFSLACHT ; ACR*2.1*13.02 IM13574
;.I IO>50,IO<55 D ^%ZISC ; ACR*2.1*13.02 IM13574
K AFSLQFLG
;I AFSLXFLG=1 D ^AFSLDKG2 F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
;I AFSLXFLG=2 D ^AFSLACH F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
;I AFSLXFLG=3 D ^AFSLACHT F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
I AFSLXFLG=1 D ^AFSLDKG2 ; ACR*2.1*13.02 IM13574
I AFSLXFLG=2 D ^AFSLACH ; ACR*2.1*13.02 IM13574
I AFSLXFLG=3 D ^AFSLACHT ; ACR*2.1*13.02 IM13574
D CLOSE^AFSLCK1 ; ACR*2.1*13.02 IM13574
I $D(AFSJFLG) K AFSJFLG G FINI
I $D(AFSLMFLG) G FINI
S AFSLECSX=AFSLNXDK_"-"_AFSLMMDD
I $D(AFSLRFLG) D
.U AFSLSDEV
.W !," *** BUT,"
.W !,"PAYEE INFORMATION HAS BEEN DELETED OR CHANGED SINCE PAYMENT WAS ENTERED INTO THIS SCHEDULE."
.W !,"YOU SHOULD EDIT THE PAYMENT AND RE-SELECT THE PAYEE (FIELD# 11) & RE-EXPORT"
.W !,"THE BATCH/SCHEDULE."
I $D(AFSLRFLG) D
.U AFSLSDEV
.;W !!,"*** I WILL NOW REMOVE FILE: ",AFSLNXDK_"-"_AFSLMMDD,". PRESS <RETURN/ENTER>" ;ACR*2.1*13.02 IM13574
.;R AFSLRTNX:300 ;ACR*2.1*13.02 IM13574
.;K AFSLRTNX ;ACR*2.1*13.02 IM13574
.W !!,"*** REMOVING FILE: "_AFSLNXDK_"-"_AFSLMMDD ;ACR*2.1*13.02 IM13574
.D PAUSE^ACRFWARN ;ACR*2.1*13.02 IM13574
.Q:$D(ACROUT) ;ACR*2.1*13.02 IM13574
I $D(AFSLRFLG) D
.;S AFSLCMD="cd /usr/spool/afsdata;rm "_AFSLNXDK_"-"_AFSLMMDD ;ACR*2.1*13.06 IM14144
.N ARMSDIR ;ACR*2.1*13.06 IM14144
.S ARMSDIR=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*13.06 IM14144
.Q:ARMSDIR']"" ;ACR*2.1*13.06 IM14144
.S AFSLCMD="cd "_ARMSDIR_";rm "_AFSLNXDK_"-"_AFSLMMDD
.K ARMSDIR
.D HOSTCMD^AFSLCKZC
.K AFSLRFLG
FINI ;
;F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
;I $D(%DEV) S IO=%DEV D ^%ZISC ;ACR*2.1*13.02 IM13574
;I $D(AFSLKDEV) S IO=AFSLKDEV D ^%ZISC ;ACR*2.1*13.02 IM13574
D CLOSE^AFSLCK1 ;ACR*2.1*13.02 IM13574
I $D(TSTXX) QUIT
K %FN,%FO,%IN,%ZA,D,D0,DA,DI,DIC,DIC(0),DIE,DIR,DQ,DR,I,J,K,L,M,X,Y
K AFSEXFN,AFSLACSY,AFSLASTX,AFSLASTZ,AFSLADD1,AFSLADD2,AFSLADD3,AFSLADD4,AFSLADR1,AFSLADR2,AFSLAID,AFSLALC,AFSLALCC,AFSLALCP,AFSLANAM,AFSLPSSN,AFSLTID,AFSLTNAM,AFSLTNOD,AFSLTSSN,AFSLVSFX
K AFSLB50,AFSLBFL1,AFSLBFL2,AFSLBFL3,AFSLBFL4,AFSLBFL5,AFSLBLCC,AFSLCMD,AFSLENCD,AFSLEXFN,AFSLFY,AFSLGFLG,AFSLKDEV,AFSLLSDK,AFSLMFLG,AFSLXPFX
K AFSLMMDD,AFSLNOW,AFSLNXDK,AFSLNXTD,AFSLNZA,AFSLNZC,AFSLPCNT,AFSLPTYP,AFSLRCT,AFSLRCTY,AFSLRECN,AFSLRFC,AFSLSAMT,AFSLSCDX,AFSLSCHD,AFSLSCR,AFSLSDK,AFSLSH11,AFSLSHDR
K AFSLSICT,AFSLSPAC,AFSLSTRL,AFSLSYMT,AFSLTAMT,AFSLTDEV,AFSLTMXX,AFSLVEIN,AFSLVNAM,AFSLXA,AFSLXC,AFSLXFLG,AFSLXX,AFSLZROS
K AFSLACT,AFSLAPPN,AFSLASY,AFSLB80,AFSLDAN,AFSLIDN,AFSLNXAN,AFSLNXPN,AFSLNXVX,AFSLPIDL,AFSLPNOT,AFSLPYNM,AFSLRTN,AFSLSDEV,AFSLSKED,AFSLTOT,AFSLVCT,AFSLVID
F I=1:1:10 K AFSLASY(I),AFSLSAM(I)
F I=1:1:14 K AFSLPREC(I)
K I
QUIT
ASKTYP ;
K DIR
S DIR(0)="S^1:ECS (Checks) Format-1;2:ECS (VENDOR ACH) Format;3:ECS (TRAVEL ACH) Format"
S DIR("A")="VERSION: "
U AFSLSDEV
D ^DIR
I $D(DTOUT)!($D(DIROUT))!($D(DIRUT))!($D(DUOUT)) S X="^"
S AFSLXFLG=X
Q
AFSLDKG ;IHS/OIRM/DSD/JDM,HJT - GEN TREAS DISKETTE FROM UNIX FILE; [ 10/27/2004 4:21 PM ]
+1 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;
+2 ;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9
+3 ;Modified for Y2K Compliance 1/11/99HJT
+4 ;Generates treasury diskette format file from unix export file
+5 ;CHANGES PER THL 090397
+6 SET %H=$HOROLOG
+7 DO YX^%DTC
+8 SET AFSLMMDD=$EXTRACT(X,4,7)
LISTFLES ;
+1 ;I $D(AFSLTRFL) G READIN1 ;ACR*2.1*13.06 IM14144
+2 ;S AFSLEXFN=AFSLFTXN ;ACR*2.1*13.06 IM14144
+3 ;S AFSEXFN="/usr/spool/afsdata/"_AFSLEXFN ;ACR*2.1*13.06 IM14144
+4 ;G READIN2 ;Never gets to the following lines ;ACR*2.1*13.06 IM14144
+5 ;D ^XBCLS ;ACR*2.1*13.06 IM14144
+6 ;W !?20,"IHS 1166/APPROVALS FOR PAYMENT SYSTEM",! ;ACR*2.1*13.06 IM14144
+7 ;W !?10,"1166 AFP FILES AVAILABLE FOR GENERATION OF TREAS DISKETTE",!!;ACR*2.1*13.06 IM14144
+8 ;S AFSLCMD="cd /usr/spool/afsdata;ls -l afslut* |more";ACR*2.1*13.06 IM14144
+9 ;D HOSTCMD^AFSLCKZC ;ACR*2.1*13.06 IM14144
+10 ;ACR*2.1*13.06 IM14144
NEW ARMSDIR
+11 ;ACR*2.1*13.06 IM14144
SET ARMSDIR=$$ARMSDIR^ACRFSYS(1)
+12 ;ACR*2.1*13.06 IM14144
IF ARMSDIR=""
GOTO FINI
+13 IF $DATA(AFSLTRFL)
GOTO READIN1
+14 SET AFSLEXFN=AFSLFTXN
+15 ;ACR*2.1*13.06 IM14144
SET AFSEXFN=ARMSDIR_AFSLEXFN
+16 GOTO READIN2
READIN1 ;
+1 SET DIR("A")="FILENAME TO USE"
+2 SET DIR(0)="F^11:14"
+3 DO ^DIR
+4 IF X["^"!(X="")
GOTO FINI
+5 IF X["?"
WRITE !!,"Enter filename (i.e., afsluta.93105)"
GOTO READIN1
+6 SET AFSLXPFX=$EXTRACT(X,1,6)
+7 IF AFSLXPFX'="afslut"
Begin DoDot:1
+8 WRITE !!,"FILENAME: ",X," IS INVALID FOR THIS OPTION."
+9 HANG 2
+10 WRITE *7
End DoDot:1
GOTO READIN1
+11 SET AFSLEXFN=X
+12 ;S AFSEXFN="/usr/spool/afsdata/"_X ;ACR*2.1*13.06 IM14144
+13 ;I $D(AFSLTRFL)
+14 ;ACR*2.1*13.06 IM14144
SET AFSEXFN=ARMSDIR_X
READIN2 ;
+1 SET AFSLDEV=IO(0)
+2 GOTO READIN3
+3 SET %ZIS("A")="Device to List ECS File Contents? "
+4 DO ^%ZIS
+5 SET AFSLDEV=IO
READIN3 ;
+1 SET AFSLSDEV=IO(0)
+2 IF '$DATA(AFSLTRFL)
SET AFSLFY=AFSLSFY
GOTO READIN4
+3 SET DIR("A")="TREASURY SCHEDULE FY"
+4 SET DIR(0)="N^1000:9999:0"
+5 USE AFSLSDEV
+6 DO ^DIR
+7 IF X["^"!(X="")
GOTO FINI
+8 IF X["?"
WRITE !!,"Enter the 4 digit fiscal year of Treasury schedule contained in the file"
GOTO READIN3
+9 SET AFSLFY=X
READIN4 ;
+1 IF '$DATA(AFSLTRFL)
SET AFSLSH11="0000"_AFSLSCHX
SET AFSLSCDX=AFSLSH11
SET X=0
GOTO GETLST
+2 SET DIR("A")="TREASURY SCHED#"
+3 SET DIR(0)="F^6:6"
+4 USE AFSLSDEV
+5 DO ^DIR
+6 IF X["^"!(X="")
GOTO FINI
+7 IF X["?"
WRITE !!,"Enter a 6 character Treasury Schedule#"
GOTO READIN4
+8 SET AFSLSH11="0000"_X
+9 SET AFSLSCDX=AFSLSH11
+10 SET X="0"
GETLST ;
+1 KILL AFSLTRFL
+2 ;I '$O(^AFSLDKGL(X)) G DOITX
+3 SET X=$ORDER(^AFSLDKGL(99999999),-1)
+4 ;G GETLST
DOITX ;
+1 WRITE !,"PLEASE WAIT.."
+2 IF X="0"
SET AFSLNXDK="001"
GOTO CONT
+3 SET AFSLLSDK=$PIECE(^AFSLDKGL(X,0),U,5)
+4 IF $PIECE(AFSLLSDK,"-",2)=AFSLMMDD
SET AFSLNXDK=$PIECE(AFSLLSDK,"-",1)
SET AFSLNXDK=AFSLNXDK+1
GOTO CONT
+5 IF $PIECE(AFSLLSDK,"-",2)'=AFSLMMDD
SET AFSLNXDK=1
GOTO CONT
CONT ;
+1 SET AFSLSYMT=0
+2 SET AFSLNXDK=$EXTRACT("000",1,3-$LENGTH(AFSLNXDK))_AFSLNXDK
+3 IF '$DATA(AFSLXFLG)
DO ASKTYP
+4 IF AFSLXFLG'=1&(AFSLXFLG'=2)&(AFSLXFLG'=3)
GOTO FINI
+5 ;I AFSLXFLG,123[AFSLXFLG D ; ACR*2.1*13.02 IM13574
+6 ;.D:AFSLXFLG=1 ^AFSLDKG2 ; ACR*2.1*13.02 IM13574
+7 ;.D:AFSLXFLG=2 ^AFSLACH ; ACR*2.1*13.02 IM13574
+8 ;.D:AFSLXFLG=3 ^AFSLACHT ; ACR*2.1*13.02 IM13574
+9 ;.I IO>50,IO<55 D ^%ZISC ; ACR*2.1*13.02 IM13574
+10 KILL AFSLQFLG
+11 ;I AFSLXFLG=1 D ^AFSLDKG2 F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
+12 ;I AFSLXFLG=2 D ^AFSLACH F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
+13 ;I AFSLXFLG=3 D ^AFSLACHT F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
+14 ; ACR*2.1*13.02 IM13574
IF AFSLXFLG=1
DO ^AFSLDKG2
+15 ; ACR*2.1*13.02 IM13574
IF AFSLXFLG=2
DO ^AFSLACH
+16 ; ACR*2.1*13.02 IM13574
IF AFSLXFLG=3
DO ^AFSLACHT
+17 ; ACR*2.1*13.02 IM13574
DO CLOSE^AFSLCK1
+18 IF $DATA(AFSJFLG)
KILL AFSJFLG
GOTO FINI
+19 IF $DATA(AFSLMFLG)
GOTO FINI
+20 SET AFSLECSX=AFSLNXDK_"-"_AFSLMMDD
+21 IF $DATA(AFSLRFLG)
Begin DoDot:1
+22 USE AFSLSDEV
+23 WRITE !," *** BUT,"
+24 WRITE !,"PAYEE INFORMATION HAS BEEN DELETED OR CHANGED SINCE PAYMENT WAS ENTERED INTO THIS SCHEDULE."
+25 WRITE !,"YOU SHOULD EDIT THE PAYMENT AND RE-SELECT THE PAYEE (FIELD# 11) & RE-EXPORT"
+26 WRITE !,"THE BATCH/SCHEDULE."
End DoDot:1
+27 IF $DATA(AFSLRFLG)
Begin DoDot:1
+28 USE AFSLSDEV
+29 ;W !!,"*** I WILL NOW REMOVE FILE: ",AFSLNXDK_"-"_AFSLMMDD,". PRESS <RETURN/ENTER>" ;ACR*2.1*13.02 IM13574
+30 ;R AFSLRTNX:300 ;ACR*2.1*13.02 IM13574
+31 ;K AFSLRTNX ;ACR*2.1*13.02 IM13574
+32 ;ACR*2.1*13.02 IM13574
WRITE !!,"*** REMOVING FILE: "_AFSLNXDK_"-"_AFSLMMDD
+33 ;ACR*2.1*13.02 IM13574
DO PAUSE^ACRFWARN
+34 ;ACR*2.1*13.02 IM13574
IF $DATA(ACROUT)
QUIT
End DoDot:1
+35 IF $DATA(AFSLRFLG)
Begin DoDot:1
+36 ;S AFSLCMD="cd /usr/spool/afsdata;rm "_AFSLNXDK_"-"_AFSLMMDD ;ACR*2.1*13.06 IM14144
+37 ;ACR*2.1*13.06 IM14144
NEW ARMSDIR
+38 ;ACR*2.1*13.06 IM14144
SET ARMSDIR=$$ARMSDIR^ACRFSYS(1)
+39 ;ACR*2.1*13.06 IM14144
IF ARMSDIR']""
QUIT
+40 SET AFSLCMD="cd "_ARMSDIR_";rm "_AFSLNXDK_"-"_AFSLMMDD
+41 KILL ARMSDIR
+42 DO HOSTCMD^AFSLCKZC
+43 KILL AFSLRFLG
End DoDot:1
FINI ;
+1 ;F I=51:1:54 S IO=I D ^%ZISC ;ACR*2.1*13.02 IM13574
+2 ;I $D(%DEV) S IO=%DEV D ^%ZISC ;ACR*2.1*13.02 IM13574
+3 ;I $D(AFSLKDEV) S IO=AFSLKDEV D ^%ZISC ;ACR*2.1*13.02 IM13574
+4 ;ACR*2.1*13.02 IM13574
DO CLOSE^AFSLCK1
+5 IF $DATA(TSTXX)
QUIT
+6 KILL %FN,%FO,%IN,%ZA,D,D0,DA,DI,DIC,DIC(0),DIE,DIR,DQ,DR,I,J,K,L,M,X,Y
+7 KILL AFSEXFN,AFSLACSY,AFSLASTX,AFSLASTZ,AFSLADD1,AFSLADD2,AFSLADD3,AFSLADD4,AFSLADR1,AFSLADR2,AFSLAID,AFSLALC,AFSLALCC,AFSLALCP,AFSLANAM,AFSLPSSN,AFSLTID,AFSLTNAM,AFSLTNOD,AFSLTSSN,AFSLVSFX
+8 KILL AFSLB50,AFSLBFL1,AFSLBFL2,AFSLBFL3,AFSLBFL4,AFSLBFL5,AFSLBLCC,AFSLCMD,AFSLENCD,AFSLEXFN,AFSLFY,AFSLGFLG,AFSLKDEV,AFSLLSDK,AFSLMFLG,AFSLXPFX
+9 KILL AFSLMMDD,AFSLNOW,AFSLNXDK,AFSLNXTD,AFSLNZA,AFSLNZC,AFSLPCNT,AFSLPTYP,AFSLRCT,AFSLRCTY,AFSLRECN,AFSLRFC,AFSLSAMT,AFSLSCDX,AFSLSCHD,AFSLSCR,AFSLSDK,AFSLSH11,AFSLSHDR
+10 KILL AFSLSICT,AFSLSPAC,AFSLSTRL,AFSLSYMT,AFSLTAMT,AFSLTDEV,AFSLTMXX,AFSLVEIN,AFSLVNAM,AFSLXA,AFSLXC,AFSLXFLG,AFSLXX,AFSLZROS
+11 KILL AFSLACT,AFSLAPPN,AFSLASY,AFSLB80,AFSLDAN,AFSLIDN,AFSLNXAN,AFSLNXPN,AFSLNXVX,AFSLPIDL,AFSLPNOT,AFSLPYNM,AFSLRTN,AFSLSDEV,AFSLSKED,AFSLTOT,AFSLVCT,AFSLVID
+12 FOR I=1:1:10
KILL AFSLASY(I),AFSLSAM(I)
+13 FOR I=1:1:14
KILL AFSLPREC(I)
+14 KILL I
+15 QUIT
ASKTYP ;
+1 KILL DIR
+2 SET DIR(0)="S^1:ECS (Checks) Format-1;2:ECS (VENDOR ACH) Format;3:ECS (TRAVEL ACH) Format"
+3 SET DIR("A")="VERSION: "
+4 USE AFSLSDEV
+5 DO ^DIR
+6 IF $DATA(DTOUT)!($DATA(DIROUT))!($DATA(DIRUT))!($DATA(DUOUT))
SET X="^"
+7 SET AFSLXFLG=X
+8 QUIT
