Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AFSLVIEW

AFSLVIEW.m

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