AFSLVIEW ;IHS/OIRM/DSD/HJT - C.O. DISPLAY LISTINGS; [ 09/27/2005 4:34 PM ]
;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
;Modified for Y2K compliance 1/5/1999HJT
;Modified further for Y2K IHS/DSD/JLG 3/8/99
;Lists open schedules by Certifying Office for technician/export-by
;date, Certifying Officer/export-by date, closed schedules to be
;certified, etc. - part 1
W !,"NOT AN ENTRY POINT" H 2 Q
PMTDEL ;EP ;DELETE PMT FM PMT BATCH ONLY
D ^XBCLS
D CRTSETUP^AFSLCRTS
W !,?20,"PAYMENT TRANSACTION DELETE"
W !!!,"NOTE: This option deletes a selected payment from a payment BATCH"
W !," ONLY and DOES NOT delete the payment record from the obligation on file."
W !!," Therefore, " W @AFSLRVON,"IF YOU ARE WANTING TO DELETE A PAYMENT FROM THE DOCUMENT",@AFSLRVOF
W !," ",@AFSLRVON,"AND PAYMENT FILES SIMULTANEOUSLY, DON'T USE THIS OPTION!",@AFSLRVOF
W !!," Instead, use 'PD - DEL PMT FM BOTH PMT & DOC FILES' found in"
W !," the UTILITIES MENU."
W !!,"PRESS RETURN"
S AFSLCHRS=1
D READCHRS^AFSLSRDR
PMTY ;
K DIR
;Begin Y2K modifications
;Changed references to 2 digit years to 4 digit year in code that follows.
S DIR(0)="N^1900:2699:0" ;Y2000
S DIR("A")="ENTER 4 DIGIT YEAR OF BATCH (i.e., '1997')" ;Y2000
D ^DIR
K DIR
I $D(DTOUT)!($D(DUOUT)) Q
I X'?4N W !,"ENTER AS PER EXAMPLE!" G PMTY ;Y2000
;End Y2k modifications
S AFSLFYR=X
D ^AFSLYRLU
I AFSLYFND="XX" W !,"YEAR NOT FOUND!" G PMTY
PMTB ;
K DIR
S DIR(0)="F^6:6"
S DIR("A")="ENTER BATCH NUMBER OF PMT(i.e.,'510001')"
D ^DIR
K DIR
I $D(DTOUT)!($D(DUOUT)) Q
I $L(X)'=6 W !,"ENTER AS PER EXAMPLE!" G PMTB
S AFSLSCHD=X
D ^AFSLSCLU
I AFSLSFND="XX" W !,"BATCH# NOT FOUND!" G PMTB
PMTS ;
K DIR
S DIR(0)="F^4:4"
S DIR("A")="ENTER SEQUENCE NO. OF PMT (i.e., '0001')"
D ^DIR
I $D(DTOUT)!($D(DUOUT)) Q
I X'?4N W !,"ENTER AS PER EXAMPLE!" G PMTS
S AFSLSQNO=X
D ^AFSLSQLU
I AFSLNFND="XX" W !,"SEQUENCE# NOT FOUND!" G PMTS
PMTD ;
W !!,"ENTER '@' WHEN SHOWN SEQ# BELOW TO DELETE THE PAYMENT SEQUENCE.",!
S DIE="^AFSLAFP(AFSLYNOD,1,AFSLSNOD,1,"
S DIC(0)="AQEM"
S DA(2)=AFSLYNOD
S DA(1)=AFSLSNOD
S DA=AFSLNNOD
S DR=".01//"
D ^DIE
K DIE
Q
OPENSC1 ;EP; LST OPN SCHDS BY C.O. FOR TECH&EXPORT-BY DT
D ^XBCLS
S L=0
S DIC="^AFSLAFP("
S FLDS="[AFSL.OPENSC]"
S BY="1,2,1,6,1,9"
D ^AFSLCTLU
;S AFSLCERT=$P(^VA(200,AFSLCOFF,0),U,1) ;ACR*2.1*19.02 IM16848
S AFSLCERT=$$NAME2^ACRFUTL1(AFSLCOFF) ;ACR*2.1*19.02 IM16848
S AFSLCERT=$P(AFSLCERT,",",1)
I AFSLCOFF=$P(^AFSLPRM(1,0),U,3) S FR="A,O,",TO="Z,O," D EN1^DIP
I AFSLCOFF'=$P(^AFSLPRM(1,0),U,3) S FR=AFSLCERT_",O,",TO=AFSLCERT_"Z,O," D EN1^DIP
D PRESS
D CERT1^AFSLOPKL
Q
OPENSC2 ;EP; LST OPN SCHDS BY C.O.&EXPORT-BY DT
D ^XBCLS
S L=0
S DIC="^AFSLAFP("
S FLDS="[AFSL.OPENSC]"
S BY="1,2;""CERT. OFFICER"",1,6,1,9"
S FR="?,O,"
S TO="?,O,"
D EN1^DIP
D PRESS
D CERT1^AFSLOPKL
Q
BTEXTYP ;EP; SET EXPORT TYPE (T/A/B/C/G) FOR A BATCH
D ^XBCLS
K DIR
;Begin Y2K modifications
S DIR(0)="F^4:4" ;Y2000
S DIR("A")="BATCH YEAR"
S DIR("T")=60
S DIR("?")="Enter the 4 digit year under which the BATCH is filed" ;Y2000
D ^DIR
I X["^" Q
I X'?4N W !,"Must enter a 4 digit year" H 2 G BTEXTYP ;Y2000
;End Y2K modifications
S AFSLFYR=X
K DIR
S DIR(0)="F^6:6"
S DIR("A")="BATCH#"
S DIR("T")=60
S DIR("?")="Enter 6 characters"
D ^DIR
I X["^" Q
I $L(X)'=6 W !,"Must enter 6 characters" H 2 G BTEXTYP
S AFSLSCHD=X
D ^AFSLYRLU
I AFSLYFND="XX"!('$D(AFSLYNOD)) W !,"THAT BATCH YEAR NOT FOUND ON FILE" H 5 Q
D ^AFSLSCLU
I AFSLSFND="XX"!('$D(AFSLSNOD)) S AFSLSNOD="" W !,"BATCH NOT FOUND ON FILE UNDER THAT YEAR" H 5 Q
S DA=AFSLSNOD
S DA(1)=AFSLYNOD
S DIE="^AFSLAFP(AFSLYNOD,1,"
S DR="3;10;22"
D ^DIE
K DIE
I $D(Y) W !,"COULD NOT CHANGE THE EXPORT TYPE! NOTIFY SUPERVISOR." H 3
I '$D(Y) W !,"THE EXPORT TYPE HAS BEEN CHANGED" H 3
Q
ACHTINFO ;EP; EDIT ACH/EFT INFO FOR TRAVELERS [GLB ^ACRAU( ]
I '$D(^ACRAPL("AC",DUZ,38)) D Q
.W !!,"You do not have authority to ADD or EDIT bank account data."
.H 5
S DIC="^ACRAU("
S DIC(0)="AEMQZ"
S DIC("A")="Person's Name (LAST,FIRST): "
W !
D ^DIC
K DIC
I +Y<1 Q
S DA=+Y
S DIE="^ACRAU("
S DR="1901T;1902T;1903T;1904T;1905T"
D ^DIE
K DA,DIE,DR
Q
ACPT1 ;
W !!,"CONFIRM ACH INFORMATION."
W !!,"YOU MAY DELETE INCORRECT INFO NOW & THEN ADD CORRECT INFO LATER."
W !,"YOU MAY NOT CHANGE THE INFO AT THIS PROMPT.",!!
W !,"ACCOUNT TYPE: ",AFSLTYP,"//"
R AFSLACPT:300
I AFSLACPT'=""&(AFSLACPT'="@") G ACPT1
I AFSLACPT="@" S DR="1901///@" D ^DIE
W !,"RTN NUMBER: ",AFSLRTN,"//"
R AFSLACPT:300
I AFSLACPT="@" S DR="1902///@" D ^DIE
S DR="1903//@" D ^DIE
Q
ACHVINFO ;EP ;EDIT ACH/EFT INFO FOR VENDORS [GLB ^AUTTVNDR( ]
I '$D(^ACRAPL("AC",DUZ,38)) D Q
.W !!,"You do not have authority to ADD or EDIT vendor account data."
.H 5
S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="Vendor/Contractor Name: "
W !
D ^DIC
K DIC
I +Y<1 Q
S DA=+Y
S DIE="^AUTTVNDR("
S DR="1901T;1902T;1903T;1904T;1905T"
D ^DIE
K DA,DIE,DR
Q
ACPT2 ;
W !!,"CONFIRM ACH INFORMATION."
W !!,"YOU MAY DELETE INCORRECT INFO NOW & THEN ADD CORRECT INFO LATER."
W !,"YOU MAY NOT CHANGE THE INFO AT THIS PROMPT.",!!
W !,"ACCOUNT TYPE: ",AFSLTYP,"//"
R AFSLACPT:300
I AFSLACPT'=""&(AFSLACPT'="@") G ACPT2
I AFSLACPT="@" S DR="1901///@" D ^DIE
W !,"RTN NUMBER: ",AFSLRTN,"//"
R AFSLACPT:300
I AFSLACPT="@" S DR="1902///@" D ^DIE
S DR="1903//@" D ^DIE
Q
CLOSC ;EP; LST CLOSED SCHDS TO BE CERT
D ^XBCLS
S L=0
S DIC="^AFSLAFP("
S FLDS="[AFSL.CLOSC]"
S BY="1,2;""CERTIFYING OFFICER: "",1,6,1,@9,1,@4"
D ^AFSLCTLU
;S AFSLCERT=$P(^VA(200,AFSLCOFF,0),U,1) ;ACR*2.1*19.02 IM16848
S AFSLCERT=$$NAME2^ACRFUTL1(AFSLCOFF) ;ACR*2.1*19.02 IM16848
S AFSLCERT=$P(AFSLCERT,",",1)
S FR="A,C,,@"
S TO="Z,C,,@"
D EN1^DIP
D PRESS
D CERT1^AFSLOPKL
Q
SUPCERT ;EP; SUPV CERT A SCHED
D ^XBCLS
S L=0
S DIC="^AFSLAFP("
S FLDS="[AFSL.CLOSC]"
S BY="1,2;""CERTIFYING OFFICER: "",1,6,1,@9,1,@4"
W !!?17,"1166 APPROVALS FOR PAYMENT SYSTEM"
W !?10,"LISTING OF BATCHES AVAILABLE TO BE CERTIFIED",!!
S AFSLABRT=""
S FR="A,C,,@"
S TO="Z,C,,@"
S IOP="HOME"
D EN1^DIP
S AFSLSPV="1"
G CERTSCX
I X'>1 W *7,!,"THERE ARE NO BATCHES TO BE CERTIFIED" S AFSLABRT="A"
D CERT3^AFSLOPKL
Q
CERTSC ;EP; CERT A SCHD
D ^XBCLS
S L=0
S DIC="^AFSLAFP("
S FLDS="[AFSL.CLOSC]"
S BY="1,2;""CERTIFYING OFFICER: "",1,6,1,@9,1,@4"
W !!?17,"1166 APPROVALS FOR PAYMENT SYSTEM"
W !?10,"LISTING OF BATCHES AVAILABLE TO BE CERTIFIED",!!
D ^AFSLCTLU
;S AFSLCERT=$P(^VA(200,AFSLCOFF,0),U,1) ;ACR*2.1*19.02 IM16848
S AFSLCERT=$$NAME2^ACRFUTL1(AFSLCOFF) ;ACR*2.1*19.02 IM16848
S AFSLCERT=$P(AFSLCERT,",",1)
S AFSLABRT=""
I AFSLCOFF=$P(^AFSLPRM(1,0),U,3) D G CERTSCX
.S FR="A,C,,@"
.S TO="Z,C,,@"
.S IOP="HOME"
.D EN1^DIP
I AFSLCOFF'=$P(^AFSLPRM(1,0),U,3) D
.S FR=AFSLCERT_",C,,@"
.S TO=AFSLCERT_"Z,C,,@"
.S IOP="HOME"
.D EN1^DIP
I '$D(X) S X=0
I X'>1 W *7,!,"YOU HAVE NO BATCHES TO BE CERTIFIED" S AFSLABRT="A"
CERTSCX ;
D PRESS
I AFSLABRT="A" G CERTEND
CERTSC2 ;
D ^XBCLS
W !!?10,"1166 APPROVALS FOR PAYMENT SYSTEM"
W !?18,"CERTIFY A BATCH",!!
I $D(AFSLFINC) D
.K AFSLFINC
.;Begin Y2K modifications ;ACR*2.1*19.05 IM16848 - ADDED PERIOD
.W *7,!!,"ENTER 4 DIGIT BATCH YEAR & 6 DIGIT BATCH NUMBER.",! ;Y2000
S AFSLABRT=""
W !!," BATCH YR:"
S AFSLCHRS=4 ;Y2000
D READCHRS^AFSLSRDR
S AFSLFYR=AFSLVOUT
I AFSLFYR["^"!(AFSLFYR="") S AFSLABRT="A" G CERTEND
I AFSLFYR["?"!(AFSLFYR'?4N) S AFSLFINC="1" G CERTSC2 ;Y2000
;End Y2K modifications
W " BATCH NO.:"
S AFSLCHRS=6
D READCHRS^AFSLSRDR
S AFSLSCHD=AFSLVOUT
I AFSLSCHD["^"!(AFSLSCHD="") S AFSLABRT="A" G CERTEND
I AFSLSCHD["?"!(AFSLSCHD'?6N) S AFSLFINC="!" G CERTSC2
D ^AFSLYRLU
D ^AFSLSCLU
S AFSLSPV=1
I '$D(AFSLSPV) S AFSLSPV="0"
I AFSLSPV="1" G CERTIFY
I AFSLCOFF=$P(^AFSLPRM(1,0),U,3) G CERTIFY
I AFSLCOFF'=DUZ D ^XBCLS W *7,!!,"THAT IS NOT YOUR BATCH!" S AFSLABRT="A" G CERTEND
CERTIFY ;EP
I '$D(AFSLYRUX) G SKYRUX
W !,"SCHED FY: ",AFSLYRUX
I '$D(AFSLBTUX) G SKYRUX
W !,"BATCH NO: ",AFSLBTUX
K DIR
S DIR(0)="Y"
S DIR("A")="CORRECT TO CERTIFY? (Y/N)",DIR("B")="Y"
D ^DIR
I $E(X)'="Y" Q
SKYRUX ;
I '$D(AFSLYNOD) W !,"PROBLEM WITH YEAR ENTERED" H 3 Q
I '$D(AFSLSNOD) W !,"PROBLEM WITH BATCH ENTERED" H 3 Q
I '$D(^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0)) W !,"PROBLEM WITH YEAR+BATCH COMBINATION ENTERED" H 3 Q
S AFSLCTP=$O(^AFSLCERT("B",DUZ,0))
S DA=AFSLSNOD
S DA(1)=AFSLYNOD
S DIE="^AFSLAFP("_AFSLYNOD_",1,"
S DR="4///NOW"
L +^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0):3
I $T D ^DIE
L -^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0):0
CERTEND ;
I $D(Y)&(AFSLABRT'="A") W *7,!!,"A PROBLEM OCCURRED WHILE CERTIFYING. NOTIFY SUPERVISOR."
I '$D(Y)&(AFSLABRT'="A") W !!,"THE BATCH HAS BEEN CERTIFIED WITH A CERTIFY DATE OF TODAY."
D PRESS
K AFSLABRT,AFSLSPV
D CERT1^AFSLOPKL
D CERT2^AFSLOPKL
D CERT3^AFSLOPKL
W !!,"CERTIFY ANOTHER BATCH? (Y/N) N//"
S AFSLCHRS=1
D READCHRS^AFSLSRDR
Q:AFSLVOUT["^"
I AFSLVOUT["?" W !,"ENTER 'Y' OR 'N'. ENTER '^' TO QUIT" G CERTEND
I AFSLVOUT="Y" G CERTSC2
Q
VIOLA ;EP; LST ACC VIOL
D VIOLA^AFSLVUE2
Q
CERTA ;EP; LST COs & ACCT TECHS
D CERTA^AFSLVUE2
Q
SQVU ;EP; DISP BATCH ENTRIES FROM A BATCH
D SQVU^AFSLVUE2
Q
K DIR S DIR(0)="F^1:1",DIR("A")=" ",DIR("A",1)="ENTER: V .... VENDOR RELATED BATCH",DIR("A",2)=" P .... PERSON RELATED BATCH" D ^DIR
I $D(DTOUT)!($D(DIROUT))!($D(DUOUT))!($D(DIRUT)) Q
I '$D(X) S X=""
I X'="V"&(X'="P") G SQVU
I X="V" D SQVU^AFSLVUE2 Q
I X="P" D SQVUP^AFSLVUE2
Q
SQVUP ;EP; DISP BATCH ENTRIES FROM A 'PERSON' BATCH
D SQVUP^AFSLVUE2
Q
SQVUX ;EP; DISP BATCH PAYMENT ENTRIES
D SQVUX^AFSLVUE2
Q
DOCVU ;EP; DISP DHR DOC
D DOCVU^AFSLVUE2
Q
DOCLKUP ;EP; LKUP FOR MULT OCCUR
D DOCLKUP^AFSLVUE2
Q
VNDLST ;EP; LIST VEND INFO
D VNDLST^AFSLVUE2
Q
EMPLST ;EP; LIST EMPL
D EMPLST^AFSLVUE2
Q
PAYTYPS ;EP; LIST PMT TYPES
D PAYTYPS^AFSLVUE2
Q
CANNOS ;EP; LIST CAN#'S & INFO
D CANNOS^AFSLVUE2
Q
OBJCLS ;EP; LIST CL CODES & INFO
D OBJCLS^AFSLVUE2
Q
PRESS ;EP
W !,"PRESS RETURN"
S AFSLCHRS=1
D READCHRS^AFSLSRDR
S AFSLRTNX=AFSLVOUT
K AFSLRTNX,AFSLVOUT,AFSLCHRS,FR,BY,TO,DIC,DA,DA(1),DHD
Q
AFSLVIEW ;IHS/OIRM/DSD/HJT - C.O. DISPLAY LISTINGS; [ 09/27/2005 4:34 PM ]
+1 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**19**;AUG 31, 2005
+2 ;Modified for Y2K compliance 1/5/1999HJT
+3 ;Modified further for Y2K IHS/DSD/JLG 3/8/99
+4 ;Lists open schedules by Certifying Office for technician/export-by
+5 ;date, Certifying Officer/export-by date, closed schedules to be
+6 ;certified, etc. - part 1
+7 WRITE !,"NOT AN ENTRY POINT"
HANG 2
QUIT
PMTDEL ;EP ;DELETE PMT FM PMT BATCH ONLY
+1 DO ^XBCLS
+2 DO CRTSETUP^AFSLCRTS
+3 WRITE !,?20,"PAYMENT TRANSACTION DELETE"
+4 WRITE !!!,"NOTE: This option deletes a selected payment from a payment BATCH"
+5 WRITE !," ONLY and DOES NOT delete the payment record from the obligation on file."
+6 WRITE !!," Therefore, "
WRITE @AFSLRVON,"IF YOU ARE WANTING TO DELETE A PAYMENT FROM THE DOCUMENT",@AFSLRVOF
+7 WRITE !," ",@AFSLRVON,"AND PAYMENT FILES SIMULTANEOUSLY, DON'T USE THIS OPTION!",@AFSLRVOF
+8 WRITE !!," Instead, use 'PD - DEL PMT FM BOTH PMT & DOC FILES' found in"
+9 WRITE !," the UTILITIES MENU."
+10 WRITE !!,"PRESS RETURN"
+11 SET AFSLCHRS=1
+12 DO READCHRS^AFSLSRDR
PMTY ;
+1 KILL DIR
+2 ;Begin Y2K modifications
+3 ;Changed references to 2 digit years to 4 digit year in code that follows.
+4 ;Y2000
SET DIR(0)="N^1900:2699:0"
+5 ;Y2000
SET DIR("A")="ENTER 4 DIGIT YEAR OF BATCH (i.e., '1997')"
+6 DO ^DIR
+7 KILL DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+9 ;Y2000
IF X'?4N
WRITE !,"ENTER AS PER EXAMPLE!"
GOTO PMTY
+10 ;End Y2k modifications
+11 SET AFSLFYR=X
+12 DO ^AFSLYRLU
+13 IF AFSLYFND="XX"
WRITE !,"YEAR NOT FOUND!"
GOTO PMTY
PMTB ;
+1 KILL DIR
+2 SET DIR(0)="F^6:6"
+3 SET DIR("A")="ENTER BATCH NUMBER OF PMT(i.e.,'510001')"
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+7 IF $LENGTH(X)'=6
WRITE !,"ENTER AS PER EXAMPLE!"
GOTO PMTB
+8 SET AFSLSCHD=X
+9 DO ^AFSLSCLU
+10 IF AFSLSFND="XX"
WRITE !,"BATCH# NOT FOUND!"
GOTO PMTB
PMTS ;
+1 KILL DIR
+2 SET DIR(0)="F^4:4"
+3 SET DIR("A")="ENTER SEQUENCE NO. OF PMT (i.e., '0001')"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+6 IF X'?4N
WRITE !,"ENTER AS PER EXAMPLE!"
GOTO PMTS
+7 SET AFSLSQNO=X
+8 DO ^AFSLSQLU
+9 IF AFSLNFND="XX"
WRITE !,"SEQUENCE# NOT FOUND!"
GOTO PMTS
PMTD ;
+1 WRITE !!,"ENTER '@' WHEN SHOWN SEQ# BELOW TO DELETE THE PAYMENT SEQUENCE.",!
+2 SET DIE="^AFSLAFP(AFSLYNOD,1,AFSLSNOD,1,"
+3 SET DIC(0)="AQEM"
+4 SET DA(2)=AFSLYNOD
+5 SET DA(1)=AFSLSNOD
+6 SET DA=AFSLNNOD
+7 SET DR=".01//"
+8 DO ^DIE
+9 KILL DIE
+10 QUIT
OPENSC1 ;EP; LST OPN SCHDS BY C.O. FOR TECH&EXPORT-BY DT
+1 DO ^XBCLS
+2 SET L=0
+3 SET DIC="^AFSLAFP("
+4 SET FLDS="[AFSL.OPENSC]"
+5 SET BY="1,2,1,6,1,9"
+6 DO ^AFSLCTLU
+7 ;S AFSLCERT=$P(^VA(200,AFSLCOFF,0),U,1) ;ACR*2.1*19.02 IM16848
+8 ;ACR*2.1*19.02 IM16848
SET AFSLCERT=$$NAME2^ACRFUTL1(AFSLCOFF)
+9 SET AFSLCERT=$PIECE(AFSLCERT,",",1)
+10 IF AFSLCOFF=$PIECE(^AFSLPRM(1,0),U,3)
SET FR="A,O,"
SET TO="Z,O,"
DO EN1^DIP
+11 IF AFSLCOFF'=$PIECE(^AFSLPRM(1,0),U,3)
SET FR=AFSLCERT_",O,"
SET TO=AFSLCERT_"Z,O,"
DO EN1^DIP
+12 DO PRESS
+13 DO CERT1^AFSLOPKL
+14 QUIT
OPENSC2 ;EP; LST OPN SCHDS BY C.O.&EXPORT-BY DT
+1 DO ^XBCLS
+2 SET L=0
+3 SET DIC="^AFSLAFP("
+4 SET FLDS="[AFSL.OPENSC]"
+5 SET BY="1,2;""CERT. OFFICER"",1,6,1,9"
+6 SET FR="?,O,"
+7 SET TO="?,O,"
+8 DO EN1^DIP
+9 DO PRESS
+10 DO CERT1^AFSLOPKL
+11 QUIT
BTEXTYP ;EP; SET EXPORT TYPE (T/A/B/C/G) FOR A BATCH
+1 DO ^XBCLS
+2 KILL DIR
+3 ;Begin Y2K modifications
+4 ;Y2000
SET DIR(0)="F^4:4"
+5 SET DIR("A")="BATCH YEAR"
+6 SET DIR("T")=60
+7 ;Y2000
SET DIR("?")="Enter the 4 digit year under which the BATCH is filed"
+8 DO ^DIR
+9 IF X["^"
QUIT
+10 ;Y2000
IF X'?4N
WRITE !,"Must enter a 4 digit year"
HANG 2
GOTO BTEXTYP
+11 ;End Y2K modifications
+12 SET AFSLFYR=X
+13 KILL DIR
+14 SET DIR(0)="F^6:6"
+15 SET DIR("A")="BATCH#"
+16 SET DIR("T")=60
+17 SET DIR("?")="Enter 6 characters"
+18 DO ^DIR
+19 IF X["^"
QUIT
+20 IF $LENGTH(X)'=6
WRITE !,"Must enter 6 characters"
HANG 2
GOTO BTEXTYP
+21 SET AFSLSCHD=X
+22 DO ^AFSLYRLU
+23 IF AFSLYFND="XX"!('$DATA(AFSLYNOD))
WRITE !,"THAT BATCH YEAR NOT FOUND ON FILE"
HANG 5
QUIT
+24 DO ^AFSLSCLU
+25 IF AFSLSFND="XX"!('$DATA(AFSLSNOD))
SET AFSLSNOD=""
WRITE !,"BATCH NOT FOUND ON FILE UNDER THAT YEAR"
HANG 5
QUIT
+26 SET DA=AFSLSNOD
+27 SET DA(1)=AFSLYNOD
+28 SET DIE="^AFSLAFP(AFSLYNOD,1,"
+29 SET DR="3;10;22"
+30 DO ^DIE
+31 KILL DIE
+32 IF $DATA(Y)
WRITE !,"COULD NOT CHANGE THE EXPORT TYPE! NOTIFY SUPERVISOR."
HANG 3
+33 IF '$DATA(Y)
WRITE !,"THE EXPORT TYPE HAS BEEN CHANGED"
HANG 3
+34 QUIT
ACHTINFO ;EP; EDIT ACH/EFT INFO FOR TRAVELERS [GLB ^ACRAU( ]
+1 IF '$DATA(^ACRAPL("AC",DUZ,38))
Begin DoDot:1
+2 WRITE !!,"You do not have authority to ADD or EDIT bank account data."
+3 HANG 5
End DoDot:1
QUIT
+4 SET DIC="^ACRAU("
+5 SET DIC(0)="AEMQZ"
+6 SET DIC("A")="Person's Name (LAST,FIRST): "
+7 WRITE !
+8 DO ^DIC
+9 KILL DIC
+10 IF +Y<1
QUIT
+11 SET DA=+Y
+12 SET DIE="^ACRAU("
+13 SET DR="1901T;1902T;1903T;1904T;1905T"
+14 DO ^DIE
+15 KILL DA,DIE,DR
+16 QUIT
ACPT1 ;
+1 WRITE !!,"CONFIRM ACH INFORMATION."
+2 WRITE !!,"YOU MAY DELETE INCORRECT INFO NOW & THEN ADD CORRECT INFO LATER."
+3 WRITE !,"YOU MAY NOT CHANGE THE INFO AT THIS PROMPT.",!!
+4 WRITE !,"ACCOUNT TYPE: ",AFSLTYP,"//"
+5 READ AFSLACPT:300
+6 IF AFSLACPT'=""&(AFSLACPT'="@")
GOTO ACPT1
+7 IF AFSLACPT="@"
SET DR="1901///@"
DO ^DIE
+8 WRITE !,"RTN NUMBER: ",AFSLRTN,"//"
+9 READ AFSLACPT:300
+10 IF AFSLACPT="@"
SET DR="1902///@"
DO ^DIE
+11 SET DR="1903//@"
DO ^DIE
+12 QUIT
ACHVINFO ;EP ;EDIT ACH/EFT INFO FOR VENDORS [GLB ^AUTTVNDR( ]
+1 IF '$DATA(^ACRAPL("AC",DUZ,38))
Begin DoDot:1
+2 WRITE !!,"You do not have authority to ADD or EDIT vendor account data."
+3 HANG 5
End DoDot:1
QUIT
+4 SET DIC="^AUTTVNDR("
+5 SET DIC(0)="AEMQZ"
+6 SET DIC("A")="Vendor/Contractor Name: "
+7 WRITE !
+8 DO ^DIC
+9 KILL DIC
+10 IF +Y<1
QUIT
+11 SET DA=+Y
+12 SET DIE="^AUTTVNDR("
+13 SET DR="1901T;1902T;1903T;1904T;1905T"
+14 DO ^DIE
+15 KILL DA,DIE,DR
+16 QUIT
ACPT2 ;
+1 WRITE !!,"CONFIRM ACH INFORMATION."
+2 WRITE !!,"YOU MAY DELETE INCORRECT INFO NOW & THEN ADD CORRECT INFO LATER."
+3 WRITE !,"YOU MAY NOT CHANGE THE INFO AT THIS PROMPT.",!!
+4 WRITE !,"ACCOUNT TYPE: ",AFSLTYP,"//"
+5 READ AFSLACPT:300
+6 IF AFSLACPT'=""&(AFSLACPT'="@")
GOTO ACPT2
+7 IF AFSLACPT="@"
SET DR="1901///@"
DO ^DIE
+8 WRITE !,"RTN NUMBER: ",AFSLRTN,"//"
+9 READ AFSLACPT:300
+10 IF AFSLACPT="@"
SET DR="1902///@"
DO ^DIE
+11 SET DR="1903//@"
DO ^DIE
+12 QUIT
CLOSC ;EP; LST CLOSED SCHDS TO BE CERT
+1 DO ^XBCLS
+2 SET L=0
+3 SET DIC="^AFSLAFP("
+4 SET FLDS="[AFSL.CLOSC]"
+5 SET BY="1,2;""CERTIFYING OFFICER: "",1,6,1,@9,1,@4"
+6 DO ^AFSLCTLU
+7 ;S AFSLCERT=$P(^VA(200,AFSLCOFF,0),U,1) ;ACR*2.1*19.02 IM16848
+8 ;ACR*2.1*19.02 IM16848
SET AFSLCERT=$$NAME2^ACRFUTL1(AFSLCOFF)
+9 SET AFSLCERT=$PIECE(AFSLCERT,",",1)
+10 SET FR="A,C,,@"
+11 SET TO="Z,C,,@"
+12 DO EN1^DIP
+13 DO PRESS
+14 DO CERT1^AFSLOPKL
+15 QUIT
SUPCERT ;EP; SUPV CERT A SCHED
+1 DO ^XBCLS
+2 SET L=0
+3 SET DIC="^AFSLAFP("
+4 SET FLDS="[AFSL.CLOSC]"
+5 SET BY="1,2;""CERTIFYING OFFICER: "",1,6,1,@9,1,@4"
+6 WRITE !!?17,"1166 APPROVALS FOR PAYMENT SYSTEM"
+7 WRITE !?10,"LISTING OF BATCHES AVAILABLE TO BE CERTIFIED",!!
+8 SET AFSLABRT=""
+9 SET FR="A,C,,@"
+10 SET TO="Z,C,,@"
+11 SET IOP="HOME"
+12 DO EN1^DIP
+13 SET AFSLSPV="1"
+14 GOTO CERTSCX
+15 IF X'>1
WRITE *7,!,"THERE ARE NO BATCHES TO BE CERTIFIED"
SET AFSLABRT="A"
+16 DO CERT3^AFSLOPKL
+17 QUIT
CERTSC ;EP; CERT A SCHD
+1 DO ^XBCLS
+2 SET L=0
+3 SET DIC="^AFSLAFP("
+4 SET FLDS="[AFSL.CLOSC]"
+5 SET BY="1,2;""CERTIFYING OFFICER: "",1,6,1,@9,1,@4"
+6 WRITE !!?17,"1166 APPROVALS FOR PAYMENT SYSTEM"
+7 WRITE !?10,"LISTING OF BATCHES AVAILABLE TO BE CERTIFIED",!!
+8 DO ^AFSLCTLU
+9 ;S AFSLCERT=$P(^VA(200,AFSLCOFF,0),U,1) ;ACR*2.1*19.02 IM16848
+10 ;ACR*2.1*19.02 IM16848
SET AFSLCERT=$$NAME2^ACRFUTL1(AFSLCOFF)
+11 SET AFSLCERT=$PIECE(AFSLCERT,",",1)
+12 SET AFSLABRT=""
+13 IF AFSLCOFF=$PIECE(^AFSLPRM(1,0),U,3)
Begin DoDot:1
+14 SET FR="A,C,,@"
+15 SET TO="Z,C,,@"
+16 SET IOP="HOME"
+17 DO EN1^DIP
End DoDot:1
GOTO CERTSCX
+18 IF AFSLCOFF'=$PIECE(^AFSLPRM(1,0),U,3)
Begin DoDot:1
+19 SET FR=AFSLCERT_",C,,@"
+20 SET TO=AFSLCERT_"Z,C,,@"
+21 SET IOP="HOME"
+22 DO EN1^DIP
End DoDot:1
+23 IF '$DATA(X)
SET X=0
+24 IF X'>1
WRITE *7,!,"YOU HAVE NO BATCHES TO BE CERTIFIED"
SET AFSLABRT="A"
CERTSCX ;
+1 DO PRESS
+2 IF AFSLABRT="A"
GOTO CERTEND
CERTSC2 ;
+1 DO ^XBCLS
+2 WRITE !!?10,"1166 APPROVALS FOR PAYMENT SYSTEM"
+3 WRITE !?18,"CERTIFY A BATCH",!!
+4 IF $DATA(AFSLFINC)
Begin DoDot:1
+5 KILL AFSLFINC
+6 ;Begin Y2K modifications ;ACR*2.1*19.05 IM16848 - ADDED PERIOD
+7 ;Y2000
WRITE *7,!!,"ENTER 4 DIGIT BATCH YEAR & 6 DIGIT BATCH NUMBER.",!
End DoDot:1
+8 SET AFSLABRT=""
+9 WRITE !!," BATCH YR:"
+10 ;Y2000
SET AFSLCHRS=4
+11 DO READCHRS^AFSLSRDR
+12 SET AFSLFYR=AFSLVOUT
+13 IF AFSLFYR["^"!(AFSLFYR="")
SET AFSLABRT="A"
GOTO CERTEND
+14 ;Y2000
IF AFSLFYR["?"!(AFSLFYR'?4N)
SET AFSLFINC="1"
GOTO CERTSC2
+15 ;End Y2K modifications
+16 WRITE " BATCH NO.:"
+17 SET AFSLCHRS=6
+18 DO READCHRS^AFSLSRDR
+19 SET AFSLSCHD=AFSLVOUT
+20 IF AFSLSCHD["^"!(AFSLSCHD="")
SET AFSLABRT="A"
GOTO CERTEND
+21 IF AFSLSCHD["?"!(AFSLSCHD'?6N)
SET AFSLFINC="!"
GOTO CERTSC2
+22 DO ^AFSLYRLU
+23 DO ^AFSLSCLU
+24 SET AFSLSPV=1
+25 IF '$DATA(AFSLSPV)
SET AFSLSPV="0"
+26 IF AFSLSPV="1"
GOTO CERTIFY
+27 IF AFSLCOFF=$PIECE(^AFSLPRM(1,0),U,3)
GOTO CERTIFY
+28 IF AFSLCOFF'=DUZ
DO ^XBCLS
WRITE *7,!!,"THAT IS NOT YOUR BATCH!"
SET AFSLABRT="A"
GOTO CERTEND
CERTIFY ;EP
+1 IF '$DATA(AFSLYRUX)
GOTO SKYRUX
+2 WRITE !,"SCHED FY: ",AFSLYRUX
+3 IF '$DATA(AFSLBTUX)
GOTO SKYRUX
+4 WRITE !,"BATCH NO: ",AFSLBTUX
+5 KILL DIR
+6 SET DIR(0)="Y"
+7 SET DIR("A")="CORRECT TO CERTIFY? (Y/N)"
SET DIR("B")="Y"
+8 DO ^DIR
+9 IF $EXTRACT(X)'="Y"
QUIT
SKYRUX ;
+1 IF '$DATA(AFSLYNOD)
WRITE !,"PROBLEM WITH YEAR ENTERED"
HANG 3
QUIT
+2 IF '$DATA(AFSLSNOD)
WRITE !,"PROBLEM WITH BATCH ENTERED"
HANG 3
QUIT
+3 IF '$DATA(^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0))
WRITE !,"PROBLEM WITH YEAR+BATCH COMBINATION ENTERED"
HANG 3
QUIT
+4 SET AFSLCTP=$ORDER(^AFSLCERT("B",DUZ,0))
+5 SET DA=AFSLSNOD
+6 SET DA(1)=AFSLYNOD
+7 SET DIE="^AFSLAFP("_AFSLYNOD_",1,"
+8 SET DR="4///NOW"
+9 LOCK +^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0):3
+10 IF $TEST
DO ^DIE
+11 LOCK -^AFSLAFP(AFSLYNOD,1,AFSLSNOD,0):0
CERTEND ;
+1 IF $DATA(Y)&(AFSLABRT'="A")
WRITE *7,!!,"A PROBLEM OCCURRED WHILE CERTIFYING. NOTIFY SUPERVISOR."
+2 IF '$DATA(Y)&(AFSLABRT'="A")
WRITE !!,"THE BATCH HAS BEEN CERTIFIED WITH A CERTIFY DATE OF TODAY."
+3 DO PRESS
+4 KILL AFSLABRT,AFSLSPV
+5 DO CERT1^AFSLOPKL
+6 DO CERT2^AFSLOPKL
+7 DO CERT3^AFSLOPKL
+8 WRITE !!,"CERTIFY ANOTHER BATCH? (Y/N) N//"
+9 SET AFSLCHRS=1
+10 DO READCHRS^AFSLSRDR
+11 IF AFSLVOUT["^"
QUIT
+12 IF AFSLVOUT["?"
WRITE !,"ENTER 'Y' OR 'N'. ENTER '^' TO QUIT"
GOTO CERTEND
+13 IF AFSLVOUT="Y"
GOTO CERTSC2
+14 QUIT
VIOLA ;EP; LST ACC VIOL
+1 DO VIOLA^AFSLVUE2
+2 QUIT
CERTA ;EP; LST COs & ACCT TECHS
+1 DO CERTA^AFSLVUE2
+2 QUIT
SQVU ;EP; DISP BATCH ENTRIES FROM A BATCH
+1 DO SQVU^AFSLVUE2
+2 QUIT
+3 KILL DIR
SET DIR(0)="F^1:1"
SET DIR("A")=" "
SET DIR("A",1)="ENTER: V .... VENDOR RELATED BATCH"
SET DIR("A",2)=" P .... PERSON RELATED BATCH"
DO ^DIR
+4 IF $DATA(DTOUT)!($DATA(DIROUT))!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+5 IF '$DATA(X)
SET X=""
+6 IF X'="V"&(X'="P")
GOTO SQVU
+7 IF X="V"
DO SQVU^AFSLVUE2
QUIT
+8 IF X="P"
DO SQVUP^AFSLVUE2
+9 QUIT
SQVUP ;EP; DISP BATCH ENTRIES FROM A 'PERSON' BATCH
+1 DO SQVUP^AFSLVUE2
+2 QUIT
SQVUX ;EP; DISP BATCH PAYMENT ENTRIES
+1 DO SQVUX^AFSLVUE2
+2 QUIT
DOCVU ;EP; DISP DHR DOC
+1 DO DOCVU^AFSLVUE2
+2 QUIT
DOCLKUP ;EP; LKUP FOR MULT OCCUR
+1 DO DOCLKUP^AFSLVUE2
+2 QUIT
VNDLST ;EP; LIST VEND INFO
+1 DO VNDLST^AFSLVUE2
+2 QUIT
EMPLST ;EP; LIST EMPL
+1 DO EMPLST^AFSLVUE2
+2 QUIT
PAYTYPS ;EP; LIST PMT TYPES
+1 DO PAYTYPS^AFSLVUE2
+2 QUIT
CANNOS ;EP; LIST CAN#'S & INFO
+1 DO CANNOS^AFSLVUE2
+2 QUIT
OBJCLS ;EP; LIST CL CODES & INFO
+1 DO OBJCLS^AFSLVUE2
+2 QUIT
PRESS ;EP
+1 WRITE !,"PRESS RETURN"
+2 SET AFSLCHRS=1
+3 DO READCHRS^AFSLSRDR
+4 SET AFSLRTNX=AFSLVOUT
+5 KILL AFSLRTNX,AFSLVOUT,AFSLCHRS,FR,BY,TO,DIC,DA,DA(1),DHD
+6 QUIT
