- ASUVAR ; IHS/ITSC/LMH -UTIL SET PACKAGE VARIABLES ; [ 06/30/2000 3:54 PM ]
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This is the SAMS package wide variable setting routine.
- I $G(U)']"" D ^XBKVAR
- I $G(ASUC("TR"))]"" D
- .I ASUC("TR")'["." S ASUC("TR")=ASUC("TR")_".0"
- I '$D(ASUL(1)) D SETAREA^ASULARST
- D ASKDATE^ASUUDATE
- D:($D(ASUK("DT"))#10)=0 ^ASUUDATE
- EN2 ;EP ;
- 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
- I '$D(ASUL(2,"STA")) D
- .S DIC("A")="ENTER STATION CODE " S DIC(0)="MEA",DIC="^ASUL(2," D ^DIC
- .I $D(DUOUT)!($D(DIROUT))!($D(DTOUT)) Q
- .I Y>0 D
- ..D STA^ASULARST(+Y)
- .E D
- ..I $G(ASUL(1,"AR","STA1"))]"" D Q:'Y ;DFM P1 9/3/98 Whole subroutine
- ...D STA^ASULARST(ASUL(1,"AR","STA1"))
- ...W !,ASUL(2,"STA","NM")," Will be default Station" N DIR S DIR(0)="Y" D ^DIR
- ...I 'Y K ASUL(2)
- I $D(DUOUT)!($D(DIROUT))!($D(DTOUT)) D Q
- .S XQUIT=1
- .W @(IOF)
- .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 !!!",!!!!
- I $G(ASUL(2,"STA","CD"))']"" D
- .W !,*7,"STATION CODE MUST BE SELECTED!!" G EN2 ;DFM P1 9/3/98
- ;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#"))
- S ASUL("ST#")=$G(ASUL(2,"STA","E#"))
- S Z=$L(ASUL(1,"AR","NM"))+27,Z=(80-Z)/2
- END ;
- Q
- ASUVAR ; IHS/ITSC/LMH -UTIL SET PACKAGE VARIABLES ; [ 06/30/2000 3:54 PM ]
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This is the SAMS package wide variable setting routine.
- +3 IF $GET(U)']""
- DO ^XBKVAR
- +4 IF $GET(ASUC("TR"))]""
- Begin DoDot:1
- +5 IF ASUC("TR")'["."
- SET ASUC("TR")=ASUC("TR")_".0"
- End DoDot:1
- +6 IF '$DATA(ASUL(1))
- DO SETAREA^ASULARST
- +7 DO ASKDATE^ASUUDATE
- +8 IF ($DATA(ASUK("DT"))#10)=0
- DO ^ASUUDATE
- EN2 ;EP ;
- +1 IF $DATA(ASUL(1,"AR","AP"))
- IF ASUL(1,"AR","AP")=U
- WRITE !?15,"*",?25," NO AREA CODE AVAILABLE",?59,"*"
- SET ASUL(1,"AR","AP")=""
- SET DUOUT=1
- GOTO END
- +2 IF '$DATA(ASUL(2,"STA"))
- Begin DoDot:1
- +3 SET DIC("A")="ENTER STATION CODE "
- SET DIC(0)="MEA"
- SET DIC="^ASUL(2,"
- DO ^DIC
- +4 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
- QUIT
- +5 IF Y>0
- Begin DoDot:2
- +6 DO STA^ASULARST(+Y)
- End DoDot:2
- +7 IF '$TEST
- Begin DoDot:2
- +8 ;DFM P1 9/3/98 Whole subroutine
- IF $GET(ASUL(1,"AR","STA1"))]""
- Begin DoDot:3
- +9 DO STA^ASULARST(ASUL(1,"AR","STA1"))
- +10 WRITE !,ASUL(2,"STA","NM")," Will be default Station"
- NEW DIR
- SET DIR(0)="Y"
- DO ^DIR
- +11 IF 'Y
- KILL ASUL(2)
- End DoDot:3
- IF 'Y
- QUIT
- End DoDot:2
- End DoDot:1
- +12 IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))
- Begin DoDot:1
- +13 SET XQUIT=1
- +14 WRITE @(IOF)
- +15 WRITE !!!!,*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 !!!",!
- !!!
- End DoDot:1
- QUIT
- +16 IF $GET(ASUL(2,"STA","CD"))']""
- Begin DoDot:1
- +17 ;DFM P1 9/3/98
- WRITE !,*7,"STATION CODE MUST BE SELECTED!!"
- GOTO EN2
- End DoDot:1
- +18 ;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#"))
- +19 SET ASUL("ST#")=$GET(ASUL(2,"STA","E#"))
- +20 SET Z=$LENGTH(ASUL(1,"AR","NM"))+27
- SET Z=(80-Z)/2
- END ;
- +1 QUIT