AFSLSNXT.m

AFSLSNXT ;IHS/OIRM/DSD/HJT - BATCH# GEN;   [ 09/27/2005  4:27 PM ]

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

 ;Modified for Y2k Compliance

 ;Opens and generates batch number

 K AFSLSFND,AFSLSNOD,AFSLSZRO

 S AFSLSCDT="NOW",(AFSLCOFF,AFSLSNXT,AFSLSTAT,AFSLUSR,AFSLERR,AFSL2OPN,AFSLTSCD)="",AFSLEBDT="MMDDYY",Y="-1",AFSLOPN="O",AFSLZROS="0000000000"

PFX ;

 S AFSLSIT=$P(^AUTTSITE(1,0),U,1),AFSLARNM=$P(^AUTTLOC(AFSLSIT,0),U,4),AFSLAREA=$P(^AUTTAREA(AFSLARNM,0),U,2),AFSLPFX=AFSLAREA

FYR ;

 ;Begin Y2k Modifications

 D ^XBCLS,CRTSETUP^AFSLCRTS W !!!,"    FISCAL YR FOR WHICH TO OPEN A BATCH/SCHEDULE (i.e.,  ""1991""): " S AFSLCHRS=4 D READCHRS^AFSLSRDR S AFSLFYR=AFSLVOUT   ;Y2000

 I AFSLFYR=""!(AFSLFYR="^") S AFSLERR="" G FINI

 I AFSLFYR'?4N S AFSLERR="INVALID ENTRY" G FINI   ;Y2000

 ;End Y2k Modifications

 D ^AFSLYRLU

 I Y<1 S AFSLERR="FISCAL YEAR NOT INITIALIZED IN FILE YET." G FINI

 D DSPF,^AFSLCTLU,EXPBDT ;I AFSL2OPN="1" S AFSLERR="" G FINI

 D SCHD G FINI

DSPF ;

 D ^XBCLS

 S DY=2,DX=23 X XY W @AFSLRVON,"1166 APPROVALS FOR PAYMENT SYSTEM"

 S DY=4,DX=31 X XY W "OPEN A BATCH/SCHEDULE",@AFSLRVOF

 S DY=8,DX=2 X XY W "BATCH/SCHEDULE NO.: ",@AFSLRVON,AFSLSNXT,@AFSLRVOF

 S DX=30 X XY W "DATE/TIME:",@AFSLRVON,AFSLSCDT,@AFSLRVOF

 S DX=60 X XY W "DUE DATE:  ",@AFSLRVON,AFSLEBDT,@AFSLRVOF

 S DY=9,DX=2 X XY W "TREASURY#: ",@AFSLRVON,AFSLTSCD,@AFSLRVOF

 S DY=18,DX=31 X XY W @AFSLRVON,AFSLSTAT,@AFSLRVOF

 ;S DY=20,DX=15 X XY W "CERTIFYING OFFICER:   ",@AFSLRVON,AFSLCOFF,@AFSLRVOF

 S DY=21,DX=15 X XY W "ACCOUNTING TECHNICIAN:",@AFSLRVON,AFSLUSR,@AFSLRVOF

 S DY=22,DX=15 X XY W @AFSLRVON,AFSLERR,@AFSLRVOF S AFSLERR=""

 Q

EXPBDT ;

 S DY=8,DX=71 X XY S AFSLCHRS=6 D READCHRS^AFSLSRDR S AFSLEBDT=AFSLVOUT

 I AFSLEBDT=""!(AFSLEBDT["^") S AFSLERR="" Q

 I AFSLEBDT'?6N W *7 S AFSLERR="***MUST ENTER 6 DIGITS**",DY=23,DX=15 X XY W @AFSLRVON,AFSLERR,@AFSLRVOF S AFSLERR="" G EXPBDT

 I $E(AFSLEBDT,1,2)<1!($E(AFSLEBDT,1,2)>12) W *7 S AFSLERR="ENTERED MONTH IS INVALID",DY=23,DX=15 X XY W @AFSLRVON,AFSLERR,@AFSLRVOF S AFSLERR="" G EXPBDT

 I $E(AFSLEBDT,3,4)<1!($E(AFSLEBDT,3,4)>31) W *7 S AFSLERR="*ENTERED DAY IS INVALID*",DY=23,DX=15 X XY W @AFSLRVON,AFSLERR,@AFSLRVOF S AFSLERR="" G EXPBDT

 S %H=$H D YX^%DTC S AFSLSCDT=$E(X,4,7)_$E(X,2,3)

 I AFSLEBDT<AFSLSCDT W *7 S AFSLERR="DUE DATE CANNOT BE < TODAY",DY=23,DX=15 X XY W @AFSLRVON,AFSLERR,@AFSLRVOF S AFSLERR="" H 3 X XY W "                           " G EXPBDT

 ;

 S ZZ=1,AFSLDFND(ZZ)="",AFSLNXSC=0,X=AFSLEBDT D ^%DT S AFSLSDDT=Y D CHKDT

 Q

SCHD ;

 I AFSLEBDT=""!(AFSLEBDT["^") Q

 S DY=10,DX=10 X XY W @AFSLRVON,"TREASURY SCHEDULE FOR WHICH THIS BATCH IS PLANNED FOR EXPORT:",@AFSLRVOF S AFSLCHRS=6 D READCHRS^AFSLSRDR S AFSLTSCD=AFSLVOUT

 I '$D(^AFSLAFP(AFSLYNOD,1,0)) S $P(^AFSLAFP(AFSLYNOD,1,0),U,1)="^9002325.01^0^0"

 I $P(^AFSLAFP(AFSLYNOD,1,0),U,4)="0" S DIC="^AFSLAFP("_AFSLYNOD_",1,",DA(1)=AFSLYNOD,DIC(0)="L",DLAYGO="9002325.01",X=AFSLPFX_"0001",AFSLSNXT=X D ^DIC,SETF

EXTYP ;

 S DY=15,DX=10 X XY W "                                                            "

 S DY=20,DX=15 X XY W "                         "

 S DY=21,DX=15 X XY W "                         "

 S DY=11,DX=1 X XY W " "

 K DIR S DIR(0)="S^T:TAPE (CHECK FORMAT GROUPED BY PAYEE;A:ACH (GROUPED BY PAYEE);B:ACH (ONE ENCLOSURE PER ENTERED PMT);C:CHECKS (GROUPED BY PAYEE)",DIR("A")="TREASURY FORMAT TYPE?",DIR("B")="A"

 D ^DIR

 S AFSLTPEX=X

 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S AFSLERR="" Q

 I AFSLTPEX="" S AFSLTPEX="A"

 I AFSLTPEX["^" S AFSLERR="" Q

 I AFSLTPEX="A" W !!,@AFSLRVON,"NOTE:  WHEN ENTERING INTO AN 'ACH-FORMAT-A' BATCH/SCHEDULE, YOU'LL ONLY",!,"       BE ALLOWED TO ENTER *1* ADDENDUM PER UNIQUE PAYEE IN BATCH.",@AFSLRVOF,"  <PRESS RETURN>" R AFSLRTNX:300 G FNDLST

 I AFSLTPEX="B" W !!,@AFSLRVON,"NOTE:  WHEN ENTERING PMTS INTO AN 'ACH-FORMAT-B' BATCH/SCHEDULE, YOU'LL BE      ",!,"       ASKED TO ENTER AN 80-COLUMN ADDENDUM FOR EACH PAYMENT ENTERED."

 I AFSLTPEX="B" W !!,"       PLEASE ENTER THE ADDENDUM FOR EACH UNIQUE PAYEE FOR THE SCHEDULE INTO THE",!,"       *** FIRST *** PAYMENT ENTERED FOR THE PAYEE.",@AFSLRVOF,"   <PRESS RETURN/ENTER>" R AFSLRTNX:300

FNDLST ;

 S AFSLSLST=0

FNDLST2 ;

 I '$O(^AFSLAFP(AFSLYNOD,1,"B",AFSLSLST)) G SCHD2

 S AFSLSLST=$O(^AFSLAFP(AFSLYNOD,1,"B",AFSLSLST))

 G FNDLST2

SCHD2 ;

 I AFSLSLST=0 S AFSLSLST=AFSLAREA_"0000"

 S AFSLSNXT=AFSLSLST+1

 S AFSLSNXT=AFSLTSCD

 S AFSLBNUM=$E(AFSLSNXT,3,6)

 I AFSLBNUM>9999 W !,"YOU MAY NOT EXCEED 9,999 BATCHES IN A FISCAL YEAR.  NOTIFY ADP MANAGER." G FINI

 I $L(AFSLSNXT)'=6 W !,"PROBLEM ENCOUNTERED COMPUTING NEXT AVAILABLE BATCH#.  NOTIFY ADP MANAGER" G FINI

 S DIC="^AFSLAFP("_AFSLYNOD_",1,",DA(1)=AFSLYNOD,DIC(0)="L",DLAYGO="9002325.01",X=AFSLSNXT D ^DIC

 I $D(AFSLRFLG) S AFSLY=Y

 D SETF

 Q

FINI ;

 I $D(AFSLRFLG) Q

 I '$D(AFSLERR) G ERRSKP

 I '$D(AFSLRVON) D CRTSETUP^AFSLCRTS

 S DY=22,DX=20 X XY W @AFSLRVON,AFSLERR,@AFSLRVOF,*7

 S DY=23,DX=54 X XY W @AFSLRVON,"<PRESS RETURN/ENTER>",@AFSLRVOF R AFSLRTNX:300

ERRSKP ;

 K AFSLCERO,AFSLCERT,AFSLCNOD,AFSLCNXT,AFSLCOFF,AFSLEBDT,AFSLERR,AFSLFYR,AFSLOPN,AFSLPFX,AFSLRTNX,AFSLSCHD,AFSLUSER,AFSLCHRS,AFSLVOUT

 K AFSLSCDT,AFSLSFND,AFSLSLST,AFSLSNOD,AFSLSNXT,AFSLSTAT,AFSLSZRO,AFSLZROS,AFSLUSR,AFSLYNOD,AFSLRVOF,AFSLRVON,AFSLYFND,AFSLYZRO

 K AFSL2OPN,AFSLOPT,AFSLAREA,AFSLARNM,AFSLDFND,AFSLNXSC,AFSLSDDT,AFSLSIT,AFSLXAST,AFSLSAD,AFSLE,AFSLSOPN

 K AFSLVDTE,AFSLVIOL,DIE,DIK,DIC,DLAYGO,DR,DX,DY,ZZ

 QUIT

SETF ;

 D ^AFSLCTLU

 S AFSLSCHD=AFSLSNXT D ^AFSLSCLU

 S %H=$H D YX^%DTC S AFSLSCDT=Y

 ;S AFSLUSR=$P(^VA(200,DUZ,0),U,1),AFSLCERT=$P(^AFSLCERT(AFSLCNOD,0),U,1),AFSLCOFF=$P(^VA(200,AFSLCERT,0),U,1)  ;ACR*2.1*19.02 IM16848

 S AFSLUSR=$$NAME2^ACRFUTL1(DUZ)        ;ACR*2.1*19.02 IM16848

 S AFSLCERT=$P(^AFSLCERT(AFSLCNOD,0),U)        ;ACR*2.1*19.02 IM16848

 S AFSLCOFF=$$NAME2^ACRFUTL1(AFSLCERT)  ;ACR*2.1*19.02 IM16848

 S AFSLCERO=AFSLCNOD

 I '$D(AFSLTPEX) S AFSLTPEX=""

 S DA=AFSLSNOD,DIE=DIC,DR="1///^S X=AFSLSCDT;2///^S X=AFSLCERO;3///^S X=AFSLEBDT;6///^S X=AFSLOPN;8///^S X=AFSLUSR;10///^S X=AFSLTSCD;22///^S X=AFSLTPEX"

 L +^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0):0 I $T D ^DIE L -^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0)

KEEPYN ;

 I $D(Y) S DIK=DIE D ^DIK S AFSLSTAT="**NOT OPENED**" Q

 S AFSLSTAT="****OPENED****"

 D DSPF

 Q

CHKDT ;

 I '$O(^AFSLAFP("J",AFSLSDDT,AFSLYNOD,AFSLNXSC)) S AFSLDFND(ZZ)="",ZZ=1 G CHKOPN

 S AFSLDFND(ZZ)=$O(^AFSLAFP("J",AFSLSDDT,AFSLYNOD,AFSLNXSC))

 S AFSLNXSC=$O(^AFSLAFP("J",AFSLSDDT,AFSLYNOD,AFSLNXSC)),ZZ=ZZ+1 G CHKDT

CHKOPN ;

 Q:AFSLDFND(ZZ)=""

 S AFSLSOPN=AFSLDFND(ZZ)

 I $D(^AFSLAFP("K","O",AFSLYNOD,AFSLSOPN)) D CHKCO

 S ZZ=ZZ+1 G CHKOPN

 Q

CHKCO ;

 S AFSLSCHD=$P(^AFSLAFP(AFSLYNOD,1,AFSLSOPN,0),U,1)

 I $D(^AFSLAFP("C",AFSLCNOD,AFSLYNOD,AFSLSOPN)) S AFSL2OPN="1",DY=15,DX=10 X XY W @AFSLRVON,"WARNING: BATCH ",AFSLSCHD," IS ALREADY OPEN FOR DUE DATE ",AFSLEBDT,".",@AFSLRVOF,*7

 Q

AFSLSNXT  ;IHS/OIRM/DSD/HJT - BATCH# GEN;   [ 09/27/2005  4:27 PM ]

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

 +2       ;Modified for Y2k Compliance

 +3       ;Opens and generates batch number

 +4        KILL AFSLSFND,AFSLSNOD,AFSLSZRO

 +5        SET AFSLSCDT="NOW"

           SET (AFSLCOFF,AFSLSNXT,AFSLSTAT,AFSLUSR,AFSLERR,AFSL2OPN,AFSLTSCD)=""

           SET AFSLEBDT="MMDDYY"

           SET Y="-1"

           SET AFSLOPN="O"

           SET AFSLZROS="0000000000"

PFX       ;

 +1        SET AFSLSIT=$PIECE(^AUTTSITE(1,0),U,1)

           SET AFSLARNM=$PIECE(^AUTTLOC(AFSLSIT,0),U,4)

           SET AFSLAREA=$PIECE(^AUTTAREA(AFSLARNM,0),U,2)

           SET AFSLPFX=AFSLAREA

FYR       ;

 +1       ;Begin Y2k Modifications

 +2       ;Y2000

           DO ^XBCLS

           DO CRTSETUP^AFSLCRTS

           WRITE !!!,"    FISCAL YR FOR WHICH TO OPEN A BATCH/SCHEDULE (i.e.,  ""1991""): "

           SET AFSLCHRS=4

           DO READCHRS^AFSLSRDR

           SET AFSLFYR=AFSLVOUT

 +3        IF AFSLFYR=""!(AFSLFYR="^")

               SET AFSLERR=""

               GOTO FINI

 +4       ;Y2000

           IF AFSLFYR'?4N

               SET AFSLERR="INVALID ENTRY"

               GOTO FINI

 +5       ;End Y2k Modifications

 +6        DO ^AFSLYRLU

 +7        IF Y<1

               SET AFSLERR="FISCAL YEAR NOT INITIALIZED IN FILE YET."

               GOTO FINI

 +8       ;I AFSL2OPN="1" S AFSLERR="" G FINI

           DO DSPF

           DO ^AFSLCTLU

           DO EXPBDT

 +9        DO SCHD

           GOTO FINI

DSPF      ;

 +1        DO ^XBCLS

 +2        SET DY=2

           SET DX=23

           XECUTE XY

           WRITE @AFSLRVON,"1166 APPROVALS FOR PAYMENT SYSTEM"

 +3        SET DY=4

           SET DX=31

           XECUTE XY

           WRITE "OPEN A BATCH/SCHEDULE",@AFSLRVOF

 +4        SET DY=8

           SET DX=2

           XECUTE XY

           WRITE "BATCH/SCHEDULE NO.: ",@AFSLRVON,AFSLSNXT,@AFSLRVOF

 +5        SET DX=30

           XECUTE XY

           WRITE "DATE/TIME:",@AFSLRVON,AFSLSCDT,@AFSLRVOF

 +6        SET DX=60

           XECUTE XY

           WRITE "DUE DATE:  ",@AFSLRVON,AFSLEBDT,@AFSLRVOF

 +7        SET DY=9

           SET DX=2

           XECUTE XY

           WRITE "TREASURY#: ",@AFSLRVON,AFSLTSCD,@AFSLRVOF

 +8        SET DY=18

           SET DX=31

           XECUTE XY

           WRITE @AFSLRVON,AFSLSTAT,@AFSLRVOF

 +9       ;S DY=20,DX=15 X XY W "CERTIFYING OFFICER:   ",@AFSLRVON,AFSLCOFF,@AFSLRVOF

 +10       SET DY=21

           SET DX=15

           XECUTE XY

           WRITE "ACCOUNTING TECHNICIAN:",@AFSLRVON,AFSLUSR,@AFSLRVOF

 +11       SET DY=22

           SET DX=15

           XECUTE XY

           WRITE @AFSLRVON,AFSLERR,@AFSLRVOF

           SET AFSLERR=""

 +12       QUIT 

EXPBDT    ;

 +1        SET DY=8

           SET DX=71

           XECUTE XY

           SET AFSLCHRS=6

           DO READCHRS^AFSLSRDR

           SET AFSLEBDT=AFSLVOUT

 +2        IF AFSLEBDT=""!(AFSLEBDT["^")

               SET AFSLERR=""

               QUIT 

 +3        IF AFSLEBDT'?6N

               WRITE *7

               SET AFSLERR="***MUST ENTER 6 DIGITS**"

               SET DY=23

               SET DX=15

               XECUTE XY

               WRITE @AFSLRVON,AFSLERR,@AFSLRVOF

               SET AFSLERR=""

               GOTO EXPBDT

 +4        IF $EXTRACT(AFSLEBDT,1,2)<1!($EXTRACT(AFSLEBDT,1,2)>12)

               WRITE *7

               SET AFSLERR="ENTERED MONTH IS INVALID"

               SET DY=23

               SET DX=15

               XECUTE XY

               WRITE @AFSLRVON,AFSLERR,@AFSLRVOF

               SET AFSLERR=""

               GOTO EXPBDT

 +5        IF $EXTRACT(AFSLEBDT,3,4)<1!($EXTRACT(AFSLEBDT,3,4)>31)

               WRITE *7

               SET AFSLERR="*ENTERED DAY IS INVALID*"

               SET DY=23

               SET DX=15

               XECUTE XY

               WRITE @AFSLRVON,AFSLERR,@AFSLRVOF

               SET AFSLERR=""

               GOTO EXPBDT

 +6        SET %H=$HOROLOG

           DO YX^%DTC

           SET AFSLSCDT=$EXTRACT(X,4,7)_$EXTRACT(X,2,3)

 +7        IF AFSLEBDT<AFSLSCDT

               WRITE *7

               SET AFSLERR="DUE DATE CANNOT BE < TODAY"

               SET DY=23

               SET DX=15

               XECUTE XY

               WRITE @AFSLRVON,AFSLERR,@AFSLRVOF

               SET AFSLERR=""

               HANG 3

               XECUTE XY

               WRITE "                           "

               GOTO EXPBDT

 +8       ;

 +9        SET ZZ=1

           SET AFSLDFND(ZZ)=""

           SET AFSLNXSC=0

           SET X=AFSLEBDT

           DO ^%DT

           SET AFSLSDDT=Y

           DO CHKDT

 +10       QUIT 

SCHD      ;

 +1        IF AFSLEBDT=""!(AFSLEBDT["^")

               QUIT 

 +2        SET DY=10

           SET DX=10

           XECUTE XY

           WRITE @AFSLRVON,"TREASURY SCHEDULE FOR WHICH THIS BATCH IS PLANNED FOR EXPORT:",@AFSLRVOF

           SET AFSLCHRS=6

           DO READCHRS^AFSLSRDR

           SET AFSLTSCD=AFSLVOUT

 +3        IF '$DATA(^AFSLAFP(AFSLYNOD,1,0))

               SET $PIECE(^AFSLAFP(AFSLYNOD,1,0),U,1)="^9002325.01^0^0"

 +4        IF $PIECE(^AFSLAFP(AFSLYNOD,1,0),U,4)="0"

               SET DIC="^AFSLAFP("_AFSLYNOD_",1,"

               SET DA(1)=AFSLYNOD

               SET DIC(0)="L"

               SET DLAYGO="9002325.01"

               SET X=AFSLPFX_"0001"

               SET AFSLSNXT=X

               DO ^DIC

               DO SETF

EXTYP     ;

 +1        SET DY=15

           SET DX=10

           XECUTE XY

           WRITE "                                                            "

 +2        SET DY=20

           SET DX=15

           XECUTE XY

           WRITE "                         "

 +3        SET DY=21

           SET DX=15

           XECUTE XY

           WRITE "                         "

 +4        SET DY=11

           SET DX=1

           XECUTE XY

           WRITE " "

 +5        KILL DIR

           SET DIR(0)="S^T:TAPE (CHECK FORMAT GROUPED BY PAYEE;A:ACH (GROUPED BY PAYEE);B:ACH (ONE ENCLOSURE PER ENTERED PMT);C:CHECKS (GROUPED BY PAYEE)"

           SET DIR("A")="TREASURY FORMAT TYPE?"

           SET DIR("B")="A"

 +6        DO ^DIR

 +7        SET AFSLTPEX=X

 +8        IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))

               SET AFSLERR=""

               QUIT 

 +9        IF AFSLTPEX=""

               SET AFSLTPEX="A"

 +10       IF AFSLTPEX["^"

               SET AFSLERR=""

               QUIT 

 +11       IF AFSLTPEX="A"

               WRITE !!,@AFSLRVON,"NOTE:  WHEN ENTERING INTO AN 'ACH-FORMAT-A' BATCH/SCHEDULE, YOU'LL ONLY",!,"       BE ALLOWED TO ENTER *1* ADDENDUM PER UNIQUE PAYEE IN BATCH.",@AFSLRVOF,"  <PRESS RETURN>"

               READ AFSLRTNX:300

               GOTO FNDLST

 +12       IF AFSLTPEX="B"

               WRITE !!,@AFSLRVON,"NOTE:  WHEN ENTERING PMTS INTO AN 'ACH-FORMAT-B' BATCH/SCHEDULE, YOU'LL BE      ",!,"       ASKED TO ENTER AN 80-COLUMN ADDENDUM FOR EACH PAYMENT ENTERED."

 +13       IF AFSLTPEX="B"

               WRITE !!,"       PLEASE ENTER THE ADDENDUM FOR EACH UNIQUE PAYEE FOR THE SCHEDULE INTO THE",!,"       *** FIRST *** PAYMENT ENTERED FOR THE PAYEE.",@AFSLRVOF,"   <PRESS RETURN/ENTER>"

               READ AFSLRTNX:300

FNDLST    ;

 +1        SET AFSLSLST=0

FNDLST2   ;

 +1        IF '$ORDER(^AFSLAFP(AFSLYNOD,1,"B",AFSLSLST))

               GOTO SCHD2

 +2        SET AFSLSLST=$ORDER(^AFSLAFP(AFSLYNOD,1,"B",AFSLSLST))

 +3        GOTO FNDLST2

SCHD2     ;

 +1        IF AFSLSLST=0

               SET AFSLSLST=AFSLAREA_"0000"

 +2        SET AFSLSNXT=AFSLSLST+1

 +3        SET AFSLSNXT=AFSLTSCD

 +4        SET AFSLBNUM=$EXTRACT(AFSLSNXT,3,6)

 +5        IF AFSLBNUM>9999

               WRITE !,"YOU MAY NOT EXCEED 9,999 BATCHES IN A FISCAL YEAR.  NOTIFY ADP MANAGER."

               GOTO FINI

 +6        IF $LENGTH(AFSLSNXT)'=6

               WRITE !,"PROBLEM ENCOUNTERED COMPUTING NEXT AVAILABLE BATCH#.  NOTIFY ADP MANAGER"

               GOTO FINI

 +7        SET DIC="^AFSLAFP("_AFSLYNOD_",1,"

           SET DA(1)=AFSLYNOD

           SET DIC(0)="L"

           SET DLAYGO="9002325.01"

           SET X=AFSLSNXT

           DO ^DIC

 +8        IF $DATA(AFSLRFLG)

               SET AFSLY=Y

 +9        DO SETF

 +10       QUIT 

FINI      ;

 +1        IF $DATA(AFSLRFLG)

               QUIT 

 +2        IF '$DATA(AFSLERR)

               GOTO ERRSKP

 +3        IF '$DATA(AFSLRVON)

               DO CRTSETUP^AFSLCRTS

 +4        SET DY=22

           SET DX=20

           XECUTE XY

           WRITE @AFSLRVON,AFSLERR,@AFSLRVOF,*7

 +5        SET DY=23

           SET DX=54

           XECUTE XY

           WRITE @AFSLRVON,"<PRESS RETURN/ENTER>",@AFSLRVOF

           READ AFSLRTNX:300

ERRSKP    ;

 +1        KILL AFSLCERO,AFSLCERT,AFSLCNOD,AFSLCNXT,AFSLCOFF,AFSLEBDT,AFSLERR,AFSLFYR,AFSLOPN,AFSLPFX,AFSLRTNX,AFSLSCHD,AFSLUSER,AFSLCHRS,AFSLVOUT

 +2        KILL AFSLSCDT,AFSLSFND,AFSLSLST,AFSLSNOD,AFSLSNXT,AFSLSTAT,AFSLSZRO,AFSLZROS,AFSLUSR,AFSLYNOD,AFSLRVOF,AFSLRVON,AFSLYFND,AFSLYZRO

 +3        KILL AFSL2OPN,AFSLOPT,AFSLAREA,AFSLARNM,AFSLDFND,AFSLNXSC,AFSLSDDT,AFSLSIT,AFSLXAST,AFSLSAD,AFSLE,AFSLSOPN

 +4        KILL AFSLVDTE,AFSLVIOL,DIE,DIK,DIC,DLAYGO,DR,DX,DY,ZZ

 +5        QUIT 

SETF      ;

 +1        DO ^AFSLCTLU

 +2        SET AFSLSCHD=AFSLSNXT

           DO ^AFSLSCLU

 +3        SET %H=$HOROLOG

           DO YX^%DTC

           SET AFSLSCDT=Y

 +4       ;S AFSLUSR=$P(^VA(200,DUZ,0),U,1),AFSLCERT=$P(^AFSLCERT(AFSLCNOD,0),U,1),AFSLCOFF=$P(^VA(200,AFSLCERT,0),U,1)  ;ACR*2.1*19.02 IM16848

 +5       ;ACR*2.1*19.02 IM16848

           SET AFSLUSR=$$NAME2^ACRFUTL1(DUZ)

 +6       ;ACR*2.1*19.02 IM16848

           SET AFSLCERT=$PIECE(^AFSLCERT(AFSLCNOD,0),U)

 +7       ;ACR*2.1*19.02 IM16848

           SET AFSLCOFF=$$NAME2^ACRFUTL1(AFSLCERT)

 +8        SET AFSLCERO=AFSLCNOD

 +9        IF '$DATA(AFSLTPEX)

               SET AFSLTPEX=""

 +10       SET DA=AFSLSNOD

           SET DIE=DIC

           SET DR="1///^S X=AFSLSCDT;2///^S X=AFSLCERO;3///^S X=AFSLEBDT;6///^S X=AFSLOPN;8///^S X=AFSLUSR;10///^S X=AFSLTSCD;22///^S X=AFSLTPEX"

 +11       LOCK +^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0):0

           IF $TEST

               DO ^DIE

               LOCK -^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0)

KEEPYN    ;

 +1        IF $DATA(Y)

               SET DIK=DIE

               DO ^DIK

               SET AFSLSTAT="**NOT OPENED**"

               QUIT 

 +2        SET AFSLSTAT="****OPENED****"

 +3        DO DSPF

 +4        QUIT 

CHKDT     ;

 +1        IF '$ORDER(^AFSLAFP("J",AFSLSDDT,AFSLYNOD,AFSLNXSC))

               SET AFSLDFND(ZZ)=""

               SET ZZ=1

               GOTO CHKOPN

 +2        SET AFSLDFND(ZZ)=$ORDER(^AFSLAFP("J",AFSLSDDT,AFSLYNOD,AFSLNXSC))

 +3        SET AFSLNXSC=$ORDER(^AFSLAFP("J",AFSLSDDT,AFSLYNOD,AFSLNXSC))

           SET ZZ=ZZ+1

           GOTO CHKDT

CHKOPN    ;

 +1        IF AFSLDFND(ZZ)=""

               QUIT 

 +2        SET AFSLSOPN=AFSLDFND(ZZ)

 +3        IF $DATA(^AFSLAFP("K","O",AFSLYNOD,AFSLSOPN))

               DO CHKCO

 +4        SET ZZ=ZZ+1

           GOTO CHKOPN

 +5        QUIT 

CHKCO     ;

 +1        SET AFSLSCHD=$PIECE(^AFSLAFP(AFSLYNOD,1,AFSLSOPN,0),U,1)

 +2        IF $DATA(^AFSLAFP("C",AFSLCNOD,AFSLYNOD,AFSLSOPN))

               SET AFSL2OPN="1"

               SET DY=15

               SET DX=10

               XECUTE XY

               WRITE @AFSLRVON,"WARNING: BATCH ",AFSLSCHD," IS ALREADY OPEN FOR DUE DATE ",AFSLEBDT,".",@AFSLRVOF,*7

 +3        QUIT