ASUVAR.m

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