ASUAUARE.m

ASUAUARE ;DSD/DFM - UTILITY GET AREA CODE;  [ 04/15/98  2:48 PM ]

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

 Q:$D(ASUK("AREA","ACCPT"))

 D CLS^ASUAULGO W *7 D:'$D(ASUK("AUTTAREA")) SETAREA I $D(ASUK("AREA","ACCPT")) I ASUK("AREA","ACCPT")=U Q

 W !?14,"REMINDER, AREA CODE YOU ARE SIGNED ON AS IS : ",ASUK("AUTTAREA"),!

 W !!?35-($L(ASUK("AREA NAME"))/2),ASUK("AREA NAME"),!!

 W !?10,"IF THIS IS CORRECT, ENTER <cr> AND CONTINUE DATA ENTRY"

 W !?10,"OTHERWISE, ENTER '^', EXIT FROM THE KERNEL STORES MENU"

 W !?15,"AND THEN REENTER WITH THE CORRECT AREA CODE",!!

 S DIR(0)="E" D ^DIR K DIR

 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S ASUK("AUTTAREA")=U

 S ASUK("AREA","ACCPT")=ASUK("AUTTAREA")

 K ASUK("AUTTAREA")

 Q

SETAREA ;EP ;SET ASUK("AUTTAREA") BASED ON DUZ(2)

 D LOOKUP

 S ASUF("LOOKA")=0

 D AREA^ASUAUTIL

 K ASUF("LOOKA")

 Q

LOOKUP ;EP ;CALL FROM ASUAUTIL

 D:'$D(U) ^XBKVAR

 I '$D(DUZ(2)) S ASUK("AREA","ACCPT")=U Q

 S ASUK("AUTTAREA")=$E($P(^AUTTAREA($P(^AUTTLOC(DUZ(2),0),U,4),0),U,4),2,3),ASUK("AREA NAME")=$P($P(^(0),U)," ",1)

 S ASUK("WAREHOUSE")=$S(ASUK("AUTTAREA")=45:0,ASUK("AUTTAREA")=53:0,ASUK("AUTTAREA")=47:0,ASUK("AUTTAREA")=51:0,ASUK("AUTTAREA")=40:0,ASUK("AUTTAREA")=41:0,1:1)

 S:ASUK("AUTTAREA")=28 ASUK("WAREHOUSE")=2,ASUK("STATION","MAIN")=28 ;SIPAN

 S:ASUK("AUTTAREA")=67 ASUK("WAREHOUSE")=2,ASUK("STATION","MAIN")=18 ;HWLHDC

 S ASUK("LOCATION")=$P(^AUTTLOC(DUZ(2),0),U,2)

 S ASUK("AREA","ACCPT")=ASUK("AUTTAREA"),ASUK("ASUFAC")=$P(^AUTTLOC(DUZ(2),0),U,10)

 I ASUK("WAREHOUSE")=1 D  ;IHS WAREHOUSE AREAS

 .I ASUK("AREA","ACCPT")=42 S ASUK("STATION","MAIN")="01" Q  ;TUCSON

 .I ASUK("AREA","ACCPT")=50 S ASUK("STATION","MAIN")="05" Q  ;OKLAHOMA

 .I ASUK("AREA","ACCPT")=51 S ASUK("STATION","MAIN")="02" Q  ;NASHVILLE

 .I ASUK("AREA","ACCPT")=54 S ASUK("STATION","MAIN")=45 Q  ;NAVAJO

 .I ASUK("AREA","ACCPT")=59 S ASUK("STATION","MAIN")=37 Q  ;ALASKA

 .I ASUK("AREA","ACCPT")=64 S ASUK("STATION","MAIN")=49 ;PORTLAND

 S ASUK("STATION","MAIN")=$G(ASUK("STATION","MAIN"))

 I ASUK("AUTTAREA")']"" W "No Accounting Point stored in your SITE file; contact site manager",!,"Program can not continue - Aborting",! S ASUK("AREA","ACCPT")="^" Q

 Q

ASUAUARE  ;DSD/DFM - UTILITY GET AREA CODE;  [ 04/15/98  2:48 PM ]

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

 +2        IF $DATA(ASUK("AREA","ACCPT"))

               QUIT 

 +3        DO CLS^ASUAULGO

           WRITE *7

           IF '$DATA(ASUK("AUTTAREA"))

               DO SETAREA

           IF $DATA(ASUK("AREA","ACCPT"))

               IF ASUK("AREA","ACCPT")=U

                   QUIT 

 +4        WRITE !?14,"REMINDER, AREA CODE YOU ARE SIGNED ON AS IS : ",ASUK("AUTTAREA"),!

 +5        WRITE !!?35-($LENGTH(ASUK("AREA NAME"))/2),ASUK("AREA NAME"),!!

 +6        WRITE !?10,"IF THIS IS CORRECT, ENTER <cr> AND CONTINUE DATA ENTRY"

 +7        WRITE !?10,"OTHERWISE, ENTER '^', EXIT FROM THE KERNEL STORES MENU"

 +8        WRITE !?15,"AND THEN REENTER WITH THE CORRECT AREA CODE",!!

 +9        SET DIR(0)="E"

           DO ^DIR

           KILL DIR

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

               SET ASUK("AUTTAREA")=U

 +11       SET ASUK("AREA","ACCPT")=ASUK("AUTTAREA")

 +12       KILL ASUK("AUTTAREA")

 +13       QUIT 

SETAREA   ;EP ;SET ASUK("AUTTAREA") BASED ON DUZ(2)

 +1        DO LOOKUP

 +2        SET ASUF("LOOKA")=0

 +3        DO AREA^ASUAUTIL

 +4        KILL ASUF("LOOKA")

 +5        QUIT 

LOOKUP    ;EP ;CALL FROM ASUAUTIL

 +1        IF '$DATA(U)

               DO ^XBKVAR

 +2        IF '$DATA(DUZ(2))

               SET ASUK("AREA","ACCPT")=U

               QUIT 

 +3        SET ASUK("AUTTAREA")=$EXTRACT($PIECE(^AUTTAREA($PIECE(^AUTTLOC(DUZ(2),0),U,4),0),U,4),2,3)

           SET ASUK("AREA NAME")=$PIECE($PIECE(^(0),U)," ",1)

 +4        SET ASUK("WAREHOUSE")=$SELECT(ASUK("AUTTAREA")=45:0,ASUK("AUTTAREA")=53:0,ASUK("AUTTAREA")=47:0,ASUK("AUTTAREA")=51:0,ASUK("AUTTAREA")=40:0,ASUK("AUTTAREA")=41:0,1:1)

 +5       ;SIPAN

           IF ASUK("AUTTAREA")=28

               SET ASUK("WAREHOUSE")=2

               SET ASUK("STATION","MAIN")=28

 +6       ;HWLHDC

           IF ASUK("AUTTAREA")=67

               SET ASUK("WAREHOUSE")=2

               SET ASUK("STATION","MAIN")=18

 +7        SET ASUK("LOCATION")=$PIECE(^AUTTLOC(DUZ(2),0),U,2)

 +8        SET ASUK("AREA","ACCPT")=ASUK("AUTTAREA")

           SET ASUK("ASUFAC")=$PIECE(^AUTTLOC(DUZ(2),0),U,10)

 +9       ;IHS WAREHOUSE AREAS

           IF ASUK("WAREHOUSE")=1

               Begin DoDot:1

 +10      ;TUCSON

                   IF ASUK("AREA","ACCPT")=42

                       SET ASUK("STATION","MAIN")="01"

                       QUIT 

 +11      ;OKLAHOMA

                   IF ASUK("AREA","ACCPT")=50

                       SET ASUK("STATION","MAIN")="05"

                       QUIT 

 +12      ;NASHVILLE

                   IF ASUK("AREA","ACCPT")=51

                       SET ASUK("STATION","MAIN")="02"

                       QUIT 

 +13      ;NAVAJO

                   IF ASUK("AREA","ACCPT")=54

                       SET ASUK("STATION","MAIN")=45

                       QUIT 

 +14      ;ALASKA

                   IF ASUK("AREA","ACCPT")=59

                       SET ASUK("STATION","MAIN")=37

                       QUIT 

 +15      ;PORTLAND

                   IF ASUK("AREA","ACCPT")=64

                       SET ASUK("STATION","MAIN")=49

               End DoDot:1

 +16       SET ASUK("STATION","MAIN")=$GET(ASUK("STATION","MAIN"))

 +17       IF ASUK("AUTTAREA")']""

               WRITE "No Accounting Point stored in your SITE file; contact site manager",!,"Program can not continue - Aborting",!

               SET ASUK("AREA","ACCPT")="^"

               QUIT 

 +18       QUIT