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

ASUVAR.m

Go to the documentation of this file.
  1. ASUVAR ; IHS/ITSC/LMH -UTIL SET PACKAGE VARIABLES ; [ 06/30/2000 3:54 PM ]
  1. ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1. ;This is the SAMS package wide variable setting routine.
  1. I $G(U)']"" D ^XBKVAR
  1. I $G(ASUC("TR"))]"" D
  1. .I ASUC("TR")'["." S ASUC("TR")=ASUC("TR")_".0"
  1. I '$D(ASUL(1)) D SETAREA^ASULARST
  1. D ASKDATE^ASUUDATE
  1. D:($D(ASUK("DT"))#10)=0 ^ASUUDATE
  1. EN2 ;EP ;
  1. I $D(ASUL(1,"AR","AP")) I ASUL(1,"AR","AP")=U W !?15,"*",?25," NO AREA CODE AVAILABLE",?59,"*" S ASUL(1,"AR","AP")="",DUOUT=1 G END
  1. I '$D(ASUL(2,"STA")) D
  1. .S DIC("A")="ENTER STATION CODE " S DIC(0)="MEA",DIC="^ASUL(2," D ^DIC
  1. .I $D(DUOUT)!($D(DIROUT))!($D(DTOUT)) Q
  1. .I Y>0 D
  1. ..D STA^ASULARST(+Y)
  1. .E D
  1. ..I $G(ASUL(1,"AR","STA1"))]"" D Q:'Y ;DFM P1 9/3/98 Whole subroutine
  1. ...D STA^ASULARST(ASUL(1,"AR","STA1"))
  1. ...W !,ASUL(2,"STA","NM")," Will be default Station" N DIR S DIR(0)="Y" D ^DIR
  1. ...I 'Y K ASUL(2)
  1. I $D(DUOUT)!($D(DIROUT))!($D(DTOUT)) D Q
  1. .S XQUIT=1
  1. .W @(IOF)
  1. .W !!!!,*7,*7,?20," * * * * W A R N I N G * * * * *",!!!!!?13," S T A T I O N N O T S E L E C T E D!!",!!!?5," A C C E S S T O S A M S N O T A L L O W E D",!!!!?5,"W I T H O U T S T A T I O N S E L E C T I O N !!!",!!!!
  1. I $G(ASUL(2,"STA","CD"))']"" D
  1. .W !,*7,"STATION CODE MUST BE SELECTED!!" G EN2 ;DFM P1 9/3/98
  1. ;REM 3/3/99 WAR->S ASUL("ARNM")=ASUL(1,"AR","NM"),ASUL("AR")=ASUL(1,"AR","AP"),ASUL("ST")=$G(ASUL(2,"STA","CD")),ASUL("STNM")=$G(ASUL(2,"STA","NM")),ASUL("ST#")=$G(ASUL(2,"STA","E#"))
  1. S ASUL("ST#")=$G(ASUL(2,"STA","E#"))
  1. S Z=$L(ASUL(1,"AR","NM"))+27,Z=(80-Z)/2
  1. END ;
  1. Q