ASUAPSST.m

ASUAPSST ;DSD/DFM - GET SUB STATION CODE FOR DICECT ISSUE;  [ 04/15/98  2:39 PM ]

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

 K ASUTRSST

 S:'$D(ASUSW("OPTIONAL")) ASUSW("OPTIONAL")="P"

 K DIC

 S ASUK("ARST")=ASUK("AREA","ACCPT")_$S(ASUK("WAREHOUSE"):ASUK("STATION","MAIN"),1:ASUTRNS(ASUTRNS,"STATION"))

 S X=ASUTRNS(ASUTRNS,"STATION")

 S DIC("S")="I $P(^(0),U,3)=ASUK(""ARST"")"

 S DIC="9002039.2"

 S DIC(0)="MX"

 W !,ASUV("ITEM #")_". SUB STATION CODE: "_X

 D ^DIC

 I $D(DTOUT)!($D(DUOUT))!($D(DICOUT)) G EXIT

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

EXIT ;RETURN TO CALLING ROUTINE

 K X,Y,DIC,ASUSW("OPTIONAL")

 Q

ASUAPSST  ;DSD/DFM - GET SUB STATION CODE FOR DICECT ISSUE;  [ 04/15/98  2:39 PM ]

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

 +2        KILL ASUTRSST

 +3        IF '$DATA(ASUSW("OPTIONAL"))

               SET ASUSW("OPTIONAL")="P"

 +4        KILL DIC

 +5        SET ASUK("ARST")=ASUK("AREA","ACCPT")_$SELECT(ASUK("WAREHOUSE"):ASUK("STATION","MAIN"),1:ASUTRNS(ASUTRNS,"STATION"))

 +6        SET X=ASUTRNS(ASUTRNS,"STATION")

 +7        SET DIC("S")="I $P(^(0),U,3)=ASUK(""ARST"")"

 +8        SET DIC="9002039.2"

 +9        SET DIC(0)="MX"

 +10       WRITE !,ASUV("ITEM #")_". SUB STATION CODE: "_X

 +11       DO ^DIC

 +12       IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DICOUT))

               GOTO EXIT

 +13       IF Y>0

               SET ASUTRSST=+Y

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

EXIT      ;RETURN TO CALLING ROUTINE

 +1        KILL X,Y,DIC,ASUSW("OPTIONAL")

 +2        QUIT