ASUAUAST.m

ASUAUAST ;DSD/DFM - UTILITY GET AREA & STATION ;  [ 04/15/98  2:50 PM ]

 ;;3.0;SAMS;**1**;AUG 20, 1993

 D AREA,STAT K DIR,DIC,X,Y Q

AREA ;EP ;AREA CODE

 K DIC S DIC=9002039.01,DIC(0)="MZE"

 W !,"2. ENTER AREA CODE: ",ASUK("AREA","ACCPT")

 S X=ASUK("AREA","ACCPT") D ^DIC I Y>0 S ASUTR(1,"AREA")=+Y

 Q

STAT ;EP ;STATION CODE CHECK

 I $E(ASUTRNS("TRANSACTION CODE"))=0 K DIC("S") G READDST

 I $D(ASUTRNS(ASUTRNS,"STATION")) I $L(ASUTRNS(ASUTRNS,"STATION"))>0 G STAFOUND

 S ASUTR(1,"STATION")=$O(^ASUTB01(ASUTR(1,"AREA"),1,"T","S","")) G:ASUTR(1,"STATION")="" STEXIT

 S ASUTRSTN=$O(^ASUTB01(ASUTR(1,"AREA"),1,"T","S",ASUTR(1,"STATION"))) I ASUTRSTN]"" K ASUTRSTN G READSTA

 K ASUTRSTN

 S ASUTRNS(ASUTRNS,"STATION")=$P(^ASUTB01(ASUTR(1,"AREA"),1,ASUTR(1,"STATION"),0),U)

 S ASUK("STATION","NAME")=$P(^ASUTB01(ASUTR(1,"AREA"),1,ASUTR(1,"STATION"),0),U,2)

STAFOUND ;

 W !,"3. ENTER STATION CODE ",ASUTRNS(ASUTRNS,"STATION")

 I '$D(ASUK("STATION","NAME")) G SETSTNM

 W ?30,ASUK("STATION","NAME") G STEXIT

READSTA ;STATION READ

 S DIC("S")="I $P(^ASUTB01(DA(1),1,+Y,0),U,3)=""S"""

READDST ;

 K ASUTRSST

 S DIR("A")="3. ENTER STATION CODE"

 S DIR("?")="Invalid Station Code for your Area"

 S DIR(0)="PE^ASUTB01("_ASUTR(1,"AREA")_",1,:MXE",DA(1)=ASUTR(1,"AREA")

 D ^ASUAUDIR

 I $D(DUOUT)!($D(DIROUT))!($D(DTOUT)) Q

 I Y>0 S ASUTR(1,"STATION")=+Y,ASUTRNS(ASUTRNS,"STATION")=$P(Y,U,2)

SETSTNM ;

 S ASUK("STATION","NAME")=$P(^ASUTB01(ASUTR(1,"AREA"),1,ASUTR(1,"STATION"),0),U,2)

 W ?30,ASUK("STATION","NAME")

STEXIT ;

 Q

ASUAUAST  ;DSD/DFM - UTILITY GET AREA & STATION ;  [ 04/15/98  2:50 PM ]

 +1       ;;3.0;SAMS;**1**;AUG 20, 1993

 +2        DO AREA

           DO STAT

           KILL DIR,DIC,X,Y

           QUIT 

AREA      ;EP ;AREA CODE

 +1        KILL DIC

           SET DIC=9002039.01

           SET DIC(0)="MZE"

 +2        WRITE !,"2. ENTER AREA CODE: ",ASUK("AREA","ACCPT")

 +3        SET X=ASUK("AREA","ACCPT")

           DO ^DIC

           IF Y>0

               SET ASUTR(1,"AREA")=+Y

 +4        QUIT 

STAT      ;EP ;STATION CODE CHECK

 +1        IF $EXTRACT(ASUTRNS("TRANSACTION CODE"))=0

               KILL DIC("S")

               GOTO READDST

 +2        IF $DATA(ASUTRNS(ASUTRNS,"STATION"))

               IF $LENGTH(ASUTRNS(ASUTRNS,"STATION"))>0

                   GOTO STAFOUND

 +3        SET ASUTR(1,"STATION")=$ORDER(^ASUTB01(ASUTR(1,"AREA"),1,"T","S",""))

           IF ASUTR(1,"STATION")=""

               GOTO STEXIT

 +4        SET ASUTRSTN=$ORDER(^ASUTB01(ASUTR(1,"AREA"),1,"T","S",ASUTR(1,"STATION")))

           IF ASUTRSTN]""

               KILL ASUTRSTN

               GOTO READSTA

 +5        KILL ASUTRSTN

 +6        SET ASUTRNS(ASUTRNS,"STATION")=$PIECE(^ASUTB01(ASUTR(1,"AREA"),1,ASUTR(1,"STATION"),0),U)

 +7        SET ASUK("STATION","NAME")=$PIECE(^ASUTB01(ASUTR(1,"AREA"),1,ASUTR(1,"STATION"),0),U,2)

STAFOUND  ;

 +1        WRITE !,"3. ENTER STATION CODE ",ASUTRNS(ASUTRNS,"STATION")

 +2        IF '$DATA(ASUK("STATION","NAME"))

               GOTO SETSTNM

 +3        WRITE ?30,ASUK("STATION","NAME")

           GOTO STEXIT

READSTA   ;STATION READ

 +1        SET DIC("S")="I $P(^ASUTB01(DA(1),1,+Y,0),U,3)=""S"""

READDST   ;

 +1        KILL ASUTRSST

 +2        SET DIR("A")="3. ENTER STATION CODE"

 +3        SET DIR("?")="Invalid Station Code for your Area"

 +4        SET DIR(0)="PE^ASUTB01("_ASUTR(1,"AREA")_",1,:MXE"

           SET DA(1)=ASUTR(1,"AREA")

 +5        DO ^ASUAUDIR

 +6        IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +7        IF Y>0

               SET ASUTR(1,"STATION")=+Y

               SET ASUTRNS(ASUTRNS,"STATION")=$PIECE(Y,U,2)

SETSTNM   ;

 +1        SET ASUK("STATION","NAME")=$PIECE(^ASUTB01(ASUTR(1,"AREA"),1,ASUTR(1,"STATION"),0),U,2)

 +2        WRITE ?30,ASUK("STATION","NAME")

STEXIT    ;

 +1        QUIT