ASUMSOLR.m

ASUMSOLR ; IHS/ITSC/LMH - ONLINE STATION MASTER REVIEW ; 

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 ;;Y2K/OK AEF/2970626

 ;

 ;This routine allows display of the Station Master file.

 ;

 ;      Program variables:

 ;      ASUAR   =  area internal number

 ;      ASUIDX  =  index internal number

 ;      ASUL(   =  array containing area and station data

 ;      ASUMS(  =  array containing station master data

 ;      ASUMX(  =  array containing index master data

 ;      ASUOUT  =  escape controller

 ;      ASUSTA  =  station internal number

 ;      ASUTXT  =  holds text to be printed

 ;      ASUY    =  holds user input

 ;

EN1 ;EP -- MAIN ENTRY POINT FOR DATA DISPLAY

 ;

 N ASUEP

 S ASUEP=1

 D START(ASUEP)

 D QUIT

 Q

EN2 ;EP -- ENTRY POINT TO EDIT PURCHASE ORDER DUE IN DATES

 ;

 N ASUEP

 S ASUEP=2

 D START(ASUEP)

 D QUIT

 Q

 ;

START(ASUEP)       ;

 ;----- START THE PROGRAM

 ;

 N ASUOUT

 F  D  Q:$G(ASUOUT)

 . N ASUAR,ASUF,ASUK,ASUMX,ASUMS,ASUS,ASUSTA,ASUV,X,Y,ZTSAVE

 . S ASUSTA=ASUL(2,"STA","E#")

 . D ^XBKVAR,HOME^%ZIS

 . K ^TMP("ASU",$J,"IDX")

 . D SETUP(.ASUL,.ASUAR,.ASUOUT) Q:$G(ASUOUT)

 . D IDX(ASUAR,ASUSTA)

 . I '$D(^TMP("ASU",$J,"IDX")) S ASUOUT=1 Q

 . I $G(ASUEP)=2 D  Q

 . . D DISP(ASUSTA,ASUEP)

 . . H 2

 . S ZTSAVE("^TMP(""ASU"",$J,""IDX"",")="",(ZTSAVE("ASUEP"),ZTSAVE("ASUSTA"))=""

 . D QUE^ASUUTIL("DQ^ASUMSOLR",.ZTSAVE,"SAMS - ONLINE STATION MASTER REVIEW")

 Q

 ;

SETUP(ASUL,ASUAR,ASUOUT)     ;

 ;----- GET ACCOUNTING POINT OR AREA INTERNAL NUMBER

 ;

 W @IOF

 W !?5,"S.A.M.S  S.T.A.T.I.O.N  M.A.S.T.E.R  O.N.L.I.N.E  R.E.V.I.E.W",!!

 I $G(ASUL(1,"AR","E#"))']"" D ^ASUVAR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q

 I $G(ASUL(1,"AR","E#"))']"" W !,"UNABLE TO FIND ACCOUNTING POINT" S ASUOUT=1 Q

 S ASUAR=ASUL(1,"AR","E#")

 Q

IDX(ASUAR,ASUSTA)  ;

 ;----- GETS INDEX NUMBERS

 ;

 N ASUOUT

 F  D  Q:$G(ASUOUT)

 . N ASUY

 . K ^TMP("ASU",$J,"IDX")

 . D GET(.ASUY,.ASUOUT)

 . Q:$G(ASUOUT)

 . D BLD(ASUY,ASUAR,ASUSTA)

 . I $D(^TMP("ASU",$J,"IDX")) S ASUOUT=1 Q

 . W !!,"You have not selected any valid items for this station.",!

 Q

GET(ASUY,ASUOUT)   ;

 ;----- PROMPTS USER FOR INDEX NUMBERS

 ;

 N DIR,X,Y

 S DIR(0)="FA"

 S DIR("A")="Enter INDEX(S): "

 S DIR("?")="Enter ONE index, a RANGE using '-', or ANY NUMBER of index numbers separated by ','"

 D ^DIR

 I Y["^"!($D(DUOUT))!($D(DTOUT)) S ASUOUT=1 Q

 S ASUY=Y

 Q

BLD(ASUY,ASUAR,ASUSTA)       ;

 ;----- BUILDS INDEX NUMBER ARRAY

 ;

 ;      Stores index numbers in ^TMP("ASU",$J,"IDX") global

 ;

 N ASUX,I

 F I=1:1:$L(ASUY,",") D

 . S ASUX=$P(ASUY,",",I)

 . I ASUX["-" D RANGE($P(ASUX,"-"),$P(ASUX,"-",2),ASUAR,ASUSTA) Q

 . S ASUX=$$PAD(ASUX,6)

 . I $L(ASUX)<8 S ASUX=ASUAR_ASUX

 . Q:$E(ASUX,1,2)'=ASUAR

 . I $D(^ASUMX(ASUX)),$D(^ASUMS(ASUSTA,1,ASUX)) S ^TMP("ASU",$J,"IDX",ASUX)=""

 Q

RANGE(X,Y,ASUAR,ASUSTA)      ;

 ;----- BUILDS ARRAY CONTAINING RANGE OF INDEX NUMBERS

 ;

 ;      X       =  starting number

 ;      Y       =  ending number

 ;

 Q:X>Y

 S X=$$PAD(X,6),Y=$$PAD(Y,6)

 I $L(X)<8 S X=ASUAR_X

 I $L(Y)<8 S Y=ASUAR_Y

 Q:$E(X,1,2)'=ASUAR

 S X=X-1 F  S X=$O(^ASUMX(X)) Q:X']""  Q:X>Y  Q:$E(X,1,2)'=ASUAR  D

 . I $D(^ASUMS(ASUSTA,1,X)) S ^TMP("ASU",$J,"IDX",X)=""

 Q

 ;

DQ ;EP -- QUEUED JOB STARTS HERE

 ;

 D DISP(ASUSTA,ASUEP)

 D QUIT

 Q

DISP(ASUSTA,ASUEP) ;

 ;----- DISPLAYS INDEX ITEM DATA

 ;

 N ASUIDX,ASUMS,ASUMX,ASUOUT

 D ^ASUVAR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q  ;DFM P1 9/3/98

 S ASUIDX=0 F  S ASUIDX=$O(^TMP("ASU",$J,"IDX",ASUIDX)) Q:'ASUIDX  D WRITE(ASUSTA,ASUIDX,.ASUMS,ASUEP,.ASUOUT) Q:$G(ASUOUT)

 Q

WRITE(ASUSTA,ASUIDX,ASUMS,ASUEP,ASUOUT)          ;

 ;----- WRITES OUTPUT

 ;

 N DIR,X,Y

 D SEGS(ASUSTA,ASUIDX,ASUEP)

 I $G(ASUEP)=2 D EDIT(ASUSTA,ASUIDX,.ASUMS,ASUEP)

 I $E(IOST)="C" S DIR(0)="E" D ^DIR I 'Y S ASUOUT=1

 Q

SEGS(ASUSTA,ASUIDX,ASUEP)         ;

 ;----- WRITES DATA SEGMENTS

 ;

 S ASUMS("E#","STA")=ASUSTA

 S (ASUMS("E#","IDX"),ASUMX("E#","IDX"))=ASUIDX

 D ^ASUMXDIO,^ASUMSTRD I ASUMS("E#","IDX")[999999 W @(IOF) W !,"INDEX ",$G(ASUMX("DELIX"))," FOR ",$G(ASUMX("DELDS"))," DELETED ",$E($G(ASUMX("DELDT")),2,3),"-",$E($G(ASUMS("DELDT")),4,5) Q

 D HDR(ASUSTA),ID(.ASUMX),SS(.ASUMS,ASUEP),OV(.ASUMS,ASUEP),DI(.ASUMS),DD(.ASUMS,ASUEP)

 Q

HDR(ASUSTA)        ;

 ;----- WRITES HEADER

 ;

 W @IOF

 N ASUTXT

 ;D STA^ASULARST(ASUSTA)

 W !,"*****"

 S ASUTXT="S T A T I O N  M A S T E R  E N T R Y  F O R"

 W ?(IOM-$L(ASUTXT))/2,ASUTXT

 W ?IOM-5,"*****"

 W !,"*****"

 S ASUTXT=$G(ASUL(2,"STA","CD"))_" - "_$G(ASUL(2,"STA","NM"))

 W ?(IOM-$L(ASUTXT))/2,ASUTXT

 W ?IOM-5,"*****"

 Q

ID(ASUMX)          ;

 ;----- WRITES INDEX ITEM DATA

 ;

 W !?(IOM-46)/2,"************** INDEX ITEM DATA ***************"

 W !,"DESCR:",?9,$G(ASUMX("DESC",1)),?41,$G(ASUMX("DESC",2))

 W !,"INDEX:" I $G(ASUMX("IDX"))]"" W ?9,$E(ASUMX("IDX"),1,5)_"."_$E(ASUMX("IDX"),6)

 W ?19,"ACCOUNT:",?29,$G(ASUMX("ACC"))

 W ?34,"DTESTB:" I $G(ASUMX("ESTB"))]"" W ?42,$E(ASUMX("ESTB"),2,3)_"/"_$E(ASUMX("ESTB"),4,5)

 W ?49,"OBJSUB:" I $G(ASUMX("SOBJ"))]"" W ?57,$S(ASUMX("SOBJ")[".":ASUMX("SOBJ"),1:$E(ASUMX("SOBJ"),1,2)_"."_$E(ASUMX("SOBJ"),3,4))

 W ?64,"CATGRY:",?74,$G(ASUMX("CAT"))

 W !,"NSN:" I $G(ASUMX("NSN"))]"" W ?9,$S($L(ASUMX("NSN"))=13:$E(ASUMX("NSN"),1,4)_"-"_$E(ASUMX("NSN"),5,6)_"-"_$E(ASUMX("NSN"),7,9)_"-"_$E(ASUMX("NSN"),10,13),1:ASUMX("NSN"))

 W ?34,"STA U/I:",?44,$G(ASUMX("AR U/I"))

 Q

SS(ASUMS,ASUEP)    ;

 ;----- WRITES STATION STATISTICS

 ;

 Q:$G(ASUEP)=2

 W !?(IOM-46)/2,"************* STATION STATISTICS *************"

 W !,"QTY OH:" I $G(ASUMS("QTY","O/H"))]"" W ?8,$J(ASUMS("QTY","O/H"),7)

 W ?19,"VALUE:" I $G(ASUMS("VAL","O/H"))]"" W ?25,$J(ASUMS("VAL","O/H"),12,2)

 W ?39,"LSTISS:" I $G(ASUMS("LSTISS")) W ?47,$E(ASUMS("LSTISS"),2,3)_"/"_$E(ASUMS("LSTISS"),4,5)

 W ?54,"DUEOUT:" I $G(ASUMS("D/O","QTY"))]"" W ?64,$J(ASUMS("D/O","QTY"),7)

 W ?72,"SLC:",?78,$G(ASUMS("SLC"))

 Q

OV(ASUMS,ASUEP)    ;

 ;----- WRITES ORDER/VENDOR DATA

 ;

 Q:$G(ASUEP)=2

 W !?(IOM-46)/2,"************ ORDER / VENDOR DATA *************"

 W !,"VENDOR:",?9,$G(ASUMS("VENAM"))

 W ?39,"ORDER#:",?49,$G(ASUMS("ORD#"))

 W !,"PAMIQ:" I $G(ASUMS("PMIQ")) W ?8,$J(ASUMS("PMIQ"),7)

 W ?19,"CUR RPQ:" I $G(ASUMS("RPQ")) W ?29,$J(ASUMS("RPQ"),7)

 W ?39,"OLD RPQ:" I $G(ASUMS("RPQ-O")) W ?49,$J(ASUMS("RPQ-O"),7)

 W ?61,"SOURCE:",?69,$G(ASUMS("SRC"))

 W !,"LASTPP:" I $G(ASUMS("LPP")) W ?7,$J(ASUMS("LPP"),10,2)

 W ?19,"LEADTIM:",?29,$J($G(ASUMS("LTM")),3,1)

 W ?39,"STDPACK:" I $G(ASUMS("SPQ")) W ?49,$J(ASUMS("SPQ"),7)

 W ?61,"VEN U/I:",?71,$G(ASUMS("VENUI"))

 W !,"EOQ TYP:",?9,$G(ASUMS("EOQ","TP"))

 W ?11,"EOQ TBL:" I $G(ASUMS("EOQ","TB")) W ?19,$J(ASUMS("EOQ","TB"),4)

 W ?24,"MOS MOD:",?34,$G(ASUMS("EOQ","MM"))

 W ?39,"QTY MOD:" I $G(ASUMS("EOQ","QM")) W ?48,$J(ASUMS("EOQ","QM"),7)

 W ?61,"ACT MOD:" I $G(ASUMS("EOQ","AM")) W ?69,$J(ASUMS("EOQ","AM"),7)

 Q

DI(ASUMS)          ;

 ;----- WRITES DUE IN DATA

 ;

 N I

 W !?(IOM-46)/2,"**************** DUE IN DATA *****************"

 F I=1:1:3 D

 . W !,"DUEIN "_I_" PO:",?12,$G(ASUMS("D/I","PO#",I))

 . W ?21,"DT:" I $G(ASUMS("D/I","DT",I)) W ?26,$E(ASUMS("D/I","DT",I),4,7),$E(ASUMS("D/I","DT",I),2,3)

 . W ?34,"QTY:" I $G(ASUMS("D/I","QTY",I)) W ?39,$J(ASUMS("D/I","QTY",I),7)

 . W ?49,"VAL:" I $G(ASUMS("D/I","VAL",I)) W ?54,$J(ASUMS("D/I","VAL",I),10,2)

 . W ?67,"ON72:" I $G(ASUMS("D/I","DTR72",I)) W ?73,$E(ASUMS("D/I","DTR72",I),4,7),$E(ASUMS("D/I","DTR72",I),2,3)

 Q

DD(ASUMS,ASUEP)    ;

 ;----- WRITES DEMAND DATA

 ;

 Q:$G(ASUEP)=2

 N ASUTOT,I,J

 W !?((IOM-46)/2),"***** DEMAND DATA (CALLS & QTY BY MONTH) *****"

 W !?5,"JAN   FEB   MAR   APR   MAY   JUN   JUL   AUG   SEP   OCT   NOV   DEC   TOT"

 W !,"CA"

 S ASUTOT=0

 F I=1:1:12 S J=(I*6)-4 S ASUTOT=ASUTOT+$G(ASUMS("DMD","CALL",I)) W ?J,$J($G(ASUMS("DMD","CALL",I)),6,0)

 W ?74,$J(ASUTOT,6,0)

 W !,"QT"

 S ASUTOT=0

 F I=1:1:12 S J=(I*6)-4 S ASUTOT=ASUTOT+$G(ASUMS("DMD","QTY",I)) W ?J,$J($G(ASUMS("DMD","QTY",I)),6,0)

 W ?74,$J(ASUTOT,6,0),!

 Q

EDIT(ASUSTA,ASUIDX,ASUMS,ASUEP)     ;

 ;----- EDITS PO DUE IN DATE

 ;

 Q:$G(ASUEP)'=2

 N ASUDATA,ASUDTFLD,ASUPOFLD,ASUOUT,DA,DIE,DIR,DR,X,Y

 S ASUPOFLD="19^24^29"

 S ASUDTFLD="20^25^30"

 F  D  Q:$G(ASUOUT)  D SEGS(ASUSTA,ASUIDX,ASUEP)

 . S ASUDATA=^ASUMS(ASUSTA,1,ASUIDX,0)

 . I $P(ASUDATA,U,20)']""&($P(ASUDATA,U,25)']"")&($P(ASUDATA,U,30)']"") S ASUOUT=1 Q

 . S DIR(0)="NO^1:3:0"

 . S DIR("A")="Which Purchase Order Due In Date do you wish to change"

 . D ^DIR K DIR

 . I Y'>0!($D(DUOUT))!($D(DTOUT)) S ASUOUT=1 Q

 . I $P(ASUDATA,U,$P(ASUPOFLD,U,Y))']"" W !!,"NO PURCHASE ORDER IN THIS FIELD",! H 2 Q

 . S DIE="^ASUMS("_ASUSTA_",1,"

 . S DA=ASUIDX

 . S DA(1)=ASUSTA

 . S DR=$P(ASUDTFLD,U,Y)

 . D ^DIE K DA,DIE,DR

 . S DIR(0)="YO"

 . S DIR("A")="Do you wish to edit another Purchase Order Due In Date for this Index"

 . S DIR("B")="NO"

 . D ^DIR K DIR

 . I 'Y S ASUOUT=1

 Q

 ;

PAD(X,Y) ;----- EXTRINSIC FUNCTION TO PAD NUMBER WITH LEADING ZEROS

 ;

 ;      X  =  number to be padded with zeros

 ;      Y  =  target length of number

 ;

 F  Q:$L(X)>(Y-1)  S X="0"_X

 Q X

QUIT ;----- CLEAN UP VARIABLES, CLOSE DEVICES, QUIT

 ;

 K ^TMP("ASU",$J,"IDX")

 D ^%ZISC

 Q

ASUMSOLR  ; IHS/ITSC/LMH - ONLINE STATION MASTER REVIEW ; 

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 +2       ;;Y2K/OK AEF/2970626

 +3       ;

 +4       ;This routine allows display of the Station Master file.

 +5       ;

 +6       ;      Program variables:

 +7       ;      ASUAR   =  area internal number

 +8       ;      ASUIDX  =  index internal number

 +9       ;      ASUL(   =  array containing area and station data

 +10      ;      ASUMS(  =  array containing station master data

 +11      ;      ASUMX(  =  array containing index master data

 +12      ;      ASUOUT  =  escape controller

 +13      ;      ASUSTA  =  station internal number

 +14      ;      ASUTXT  =  holds text to be printed

 +15      ;      ASUY    =  holds user input

 +16      ;

EN1       ;EP -- MAIN ENTRY POINT FOR DATA DISPLAY

 +1       ;

 +2        NEW ASUEP

 +3        SET ASUEP=1

 +4        DO START(ASUEP)

 +5        DO QUIT

 +6        QUIT 

EN2       ;EP -- ENTRY POINT TO EDIT PURCHASE ORDER DUE IN DATES

 +1       ;

 +2        NEW ASUEP

 +3        SET ASUEP=2

 +4        DO START(ASUEP)

 +5        DO QUIT

 +6        QUIT 

 +7       ;

START(ASUEP) ;

 +1       ;----- START THE PROGRAM

 +2       ;

 +3        NEW ASUOUT

 +4        FOR 

               Begin DoDot:1

 +5                NEW ASUAR,ASUF,ASUK,ASUMX,ASUMS,ASUS,ASUSTA,ASUV,X,Y,ZTSAVE

 +6                SET ASUSTA=ASUL(2,"STA","E#")

 +7                DO ^XBKVAR

                   DO HOME^%ZIS

 +8                KILL ^TMP("ASU",$JOB,"IDX")

 +9                DO SETUP(.ASUL,.ASUAR,.ASUOUT)

                   IF $GET(ASUOUT)

                       QUIT 

 +10               DO IDX(ASUAR,ASUSTA)

 +11               IF '$DATA(^TMP("ASU",$JOB,"IDX"))

                       SET ASUOUT=1

                       QUIT 

 +12               IF $GET(ASUEP)=2

                       Begin DoDot:2

 +13                       DO DISP(ASUSTA,ASUEP)

 +14                       HANG 2

                       End DoDot:2

                       QUIT 

 +15               SET ZTSAVE("^TMP(""ASU"",$J,""IDX"",")=""

                   SET (ZTSAVE("ASUEP"),ZTSAVE("ASUSTA"))=""

 +16               DO QUE^ASUUTIL("DQ^ASUMSOLR",.ZTSAVE,"SAMS - ONLINE STATION MASTER REVIEW")

               End DoDot:1

               IF $GET(ASUOUT)

                   QUIT 

 +17       QUIT 

 +18      ;

SETUP(ASUL,ASUAR,ASUOUT) ;

 +1       ;----- GET ACCOUNTING POINT OR AREA INTERNAL NUMBER

 +2       ;

 +3        WRITE @IOF

 +4        WRITE !?5,"S.A.M.S  S.T.A.T.I.O.N  M.A.S.T.E.R  O.N.L.I.N.E  R.E.V.I.E.W",!!

 +5        IF $GET(ASUL(1,"AR","E#"))']""

               DO ^ASUVAR

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

                   QUIT 

 +6        IF $GET(ASUL(1,"AR","E#"))']""

               WRITE !,"UNABLE TO FIND ACCOUNTING POINT"

               SET ASUOUT=1

               QUIT 

 +7        SET ASUAR=ASUL(1,"AR","E#")

 +8        QUIT 

IDX(ASUAR,ASUSTA) ;

 +1       ;----- GETS INDEX NUMBERS

 +2       ;

 +3        NEW ASUOUT

 +4        FOR 

               Begin DoDot:1

 +5                NEW ASUY

 +6                KILL ^TMP("ASU",$JOB,"IDX")

 +7                DO GET(.ASUY,.ASUOUT)

 +8                IF $GET(ASUOUT)

                       QUIT 

 +9                DO BLD(ASUY,ASUAR,ASUSTA)

 +10               IF $DATA(^TMP("ASU",$JOB,"IDX"))

                       SET ASUOUT=1

                       QUIT 

 +11               WRITE !!,"You have not selected any valid items for this station.",!

               End DoDot:1

               IF $GET(ASUOUT)

                   QUIT 

 +12       QUIT 

GET(ASUY,ASUOUT) ;

 +1       ;----- PROMPTS USER FOR INDEX NUMBERS

 +2       ;

 +3        NEW DIR,X,Y

 +4        SET DIR(0)="FA"

 +5        SET DIR("A")="Enter INDEX(S): "

 +6        SET DIR("?")="Enter ONE index, a RANGE using '-', or ANY NUMBER of index numbers separated by ','"

 +7        DO ^DIR

 +8        IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))

               SET ASUOUT=1

               QUIT 

 +9        SET ASUY=Y

 +10       QUIT 

BLD(ASUY,ASUAR,ASUSTA) ;

 +1       ;----- BUILDS INDEX NUMBER ARRAY

 +2       ;

 +3       ;      Stores index numbers in ^TMP("ASU",$J,"IDX") global

 +4       ;

 +5        NEW ASUX,I

 +6        FOR I=1:1:$LENGTH(ASUY,",")

               Begin DoDot:1

 +7                SET ASUX=$PIECE(ASUY,",",I)

 +8                IF ASUX["-"

                       DO RANGE($PIECE(ASUX,"-"),$PIECE(ASUX,"-",2),ASUAR,ASUSTA)

                       QUIT 

 +9                SET ASUX=$$PAD(ASUX,6)

 +10               IF $LENGTH(ASUX)<8

                       SET ASUX=ASUAR_ASUX

 +11               IF $EXTRACT(ASUX,1,2)'=ASUAR

                       QUIT 

 +12               IF $DATA(^ASUMX(ASUX))

                       IF $DATA(^ASUMS(ASUSTA,1,ASUX))

                           SET ^TMP("ASU",$JOB,"IDX",ASUX)=""

               End DoDot:1

 +13       QUIT 

RANGE(X,Y,ASUAR,ASUSTA) ;

 +1       ;----- BUILDS ARRAY CONTAINING RANGE OF INDEX NUMBERS

 +2       ;

 +3       ;      X       =  starting number

 +4       ;      Y       =  ending number

 +5       ;

 +6        IF X>Y

               QUIT 

 +7        SET X=$$PAD(X,6)

           SET Y=$$PAD(Y,6)

 +8        IF $LENGTH(X)<8

               SET X=ASUAR_X

 +9        IF $LENGTH(Y)<8

               SET Y=ASUAR_Y

 +10       IF $EXTRACT(X,1,2)'=ASUAR

               QUIT 

 +11       SET X=X-1

           FOR 

               SET X=$ORDER(^ASUMX(X))

               IF X']""

                   QUIT 

               IF X>Y

                   QUIT 

               IF $EXTRACT(X,1,2)'=ASUAR

                   QUIT 

               Begin DoDot:1

 +12               IF $DATA(^ASUMS(ASUSTA,1,X))

                       SET ^TMP("ASU",$JOB,"IDX",X)=""

               End DoDot:1

 +13       QUIT 

 +14      ;

DQ        ;EP -- QUEUED JOB STARTS HERE

 +1       ;

 +2        DO DISP(ASUSTA,ASUEP)

 +3        DO QUIT

 +4        QUIT 

DISP(ASUSTA,ASUEP) ;

 +1       ;----- DISPLAYS INDEX ITEM DATA

 +2       ;

 +3        NEW ASUIDX,ASUMS,ASUMX,ASUOUT

 +4       ;DFM P1 9/3/98

           DO ^ASUVAR

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

               QUIT 

 +5        SET ASUIDX=0

           FOR 

               SET ASUIDX=$ORDER(^TMP("ASU",$JOB,"IDX",ASUIDX))

               IF 'ASUIDX

                   QUIT 

               DO WRITE(ASUSTA,ASUIDX,.ASUMS,ASUEP,.ASUOUT)

               IF $GET(ASUOUT)

                   QUIT 

 +6        QUIT 

WRITE(ASUSTA,ASUIDX,ASUMS,ASUEP,ASUOUT) ;

 +1       ;----- WRITES OUTPUT

 +2       ;

 +3        NEW DIR,X,Y

 +4        DO SEGS(ASUSTA,ASUIDX,ASUEP)

 +5        IF $GET(ASUEP)=2

               DO EDIT(ASUSTA,ASUIDX,.ASUMS,ASUEP)

 +6        IF $EXTRACT(IOST)="C"

               SET DIR(0)="E"

               DO ^DIR

               IF 'Y

                   SET ASUOUT=1

 +7        QUIT 

SEGS(ASUSTA,ASUIDX,ASUEP) ;

 +1       ;----- WRITES DATA SEGMENTS

 +2       ;

 +3        SET ASUMS("E#","STA")=ASUSTA

 +4        SET (ASUMS("E#","IDX"),ASUMX("E#","IDX"))=ASUIDX

 +5        DO ^ASUMXDIO

           DO ^ASUMSTRD

           IF ASUMS("E#","IDX")[999999

               WRITE @(IOF)

               WRITE !,"INDEX ",$GET">GET">GET">GET">GET">GET">GET">GET(ASUMX("DELIX"))," FOR ",$GET">GET">GET">GET">GET">GET">GET">GET(ASUMX("DELDS"))," DELETED ",$EXTRACT($GET">GET">GET">GET">GET">GET">GET">GET(ASUMX("DELDT")),2,3),"-",$EXTRACT($GET">GET">GET">GET">GET">GET">GET">GET(ASUMS("DELDT")),4,5)

               QUIT 

 +6        DO HDR(ASUSTA)

           DO ID(.ASUMX)

           DO SS(.ASUMS,ASUEP)

           DO OV(.ASUMS,ASUEP)

           DO DI(.ASUMS)

           DO DD(.ASUMS,ASUEP)

 +7        QUIT 

HDR(ASUSTA) ;

 +1       ;----- WRITES HEADER

 +2       ;

 +3        WRITE @IOF

 +4        NEW ASUTXT

 +5       ;D STA^ASULARST(ASUSTA)

 +6        WRITE !,"*****"

 +7        SET ASUTXT="S T A T I O N  M A S T E R  E N T R Y  F O R"

 +8        WRITE ?(IOM-$LENGTH(ASUTXT))/2,ASUTXT

 +9        WRITE ?IOM-5,"*****"

 +10       WRITE !,"*****"

 +11       SET ASUTXT=$GET">GET(ASUL(2,"STA","CD"))_" - "_$GET">GET(ASUL(2,"STA","NM"))

 +12       WRITE ?(IOM-$LENGTH(ASUTXT))/2,ASUTXT

 +13       WRITE ?IOM-5,"*****"

 +14       QUIT 

ID(ASUMX) ;

 +1       ;----- WRITES INDEX ITEM DATA

 +2       ;

 +3        WRITE !?(IOM-46)/2,"************** INDEX ITEM DATA ***************"

 +4        WRITE !,"DESCR:",?9,$GET">GET(ASUMX("DESC",1)),?41,$GET">GET(ASUMX("DESC",2))

 +5        WRITE !,"INDEX:"

           IF $GET(ASUMX("IDX"))]""

               WRITE ?9,$EXTRACT(ASUMX("IDX"),1,5)_"."_$EXTRACT(ASUMX("IDX"),6)

 +6        WRITE ?19,"ACCOUNT:",?29,$GET(ASUMX("ACC"))

 +7        WRITE ?34,"DTESTB:"

           IF $GET(ASUMX("ESTB"))]""

               WRITE ?42,$EXTRACT(ASUMX("ESTB"),2,3)_"/"_$EXTRACT(ASUMX("ESTB"),4,5)

 +8        WRITE ?49,"OBJSUB:"

           IF $GET(ASUMX("SOBJ"))]""

               WRITE ?57,$SELECT(ASUMX("SOBJ")[".":ASUMX("SOBJ"),1:$EXTRACT(ASUMX("SOBJ"),1,2)_"."_$EXTRACT(ASUMX("SOBJ"),3,4))

 +9        WRITE ?64,"CATGRY:",?74,$GET(ASUMX("CAT"))

 +10       WRITE !,"NSN:"

           IF $GET(ASUMX("NSN"))]""

               WRITE ?9,$SELECT($LENGTH(ASUMX("NSN"))=13:$EXTRACT(ASUMX("NSN"),1,4)_"-"_$EXTRACT(ASUMX("NSN"),5,6)_"-"_$EXTRACT(ASUMX("NSN"),7,9)_"-"_$EXTRACT(ASUMX("NSN"),10,13),1:ASUMX("NSN"))

 +11       WRITE ?34,"STA U/I:",?44,$GET(ASUMX("AR U/I"))

 +12       QUIT 

SS(ASUMS,ASUEP) ;

 +1       ;----- WRITES STATION STATISTICS

 +2       ;

 +3        IF $GET(ASUEP)=2

               QUIT 

 +4        WRITE !?(IOM-46)/2,"************* STATION STATISTICS *************"

 +5        WRITE !,"QTY OH:"

           IF $GET(ASUMS("QTY","O/H"))]""

               WRITE ?8,$JUSTIFY(ASUMS("QTY","O/H"),7)

 +6        WRITE ?19,"VALUE:"

           IF $GET(ASUMS("VAL","O/H"))]""

               WRITE ?25,$JUSTIFY(ASUMS("VAL","O/H"),12,2)

 +7        WRITE ?39,"LSTISS:"

           IF $GET(ASUMS("LSTISS"))

               WRITE ?47,$EXTRACT(ASUMS("LSTISS"),2,3)_"/"_$EXTRACT(ASUMS("LSTISS"),4,5)

 +8        WRITE ?54,"DUEOUT:"

           IF $GET(ASUMS("D/O","QTY"))]""

               WRITE ?64,$JUSTIFY(ASUMS("D/O","QTY"),7)

 +9        WRITE ?72,"SLC:",?78,$GET(ASUMS("SLC"))

 +10       QUIT 

OV(ASUMS,ASUEP) ;

 +1       ;----- WRITES ORDER/VENDOR DATA

 +2       ;

 +3        IF $GET(ASUEP)=2

               QUIT 

 +4        WRITE !?(IOM-46)/2,"************ ORDER / VENDOR DATA *************"

 +5        WRITE !,"VENDOR:",?9,$GET(ASUMS("VENAM"))

 +6        WRITE ?39,"ORDER#:",?49,$GET(ASUMS("ORD#"))

 +7        WRITE !,"PAMIQ:"

           IF $GET(ASUMS("PMIQ"))

               WRITE ?8,$JUSTIFY(ASUMS("PMIQ"),7)

 +8        WRITE ?19,"CUR RPQ:"

           IF $GET(ASUMS("RPQ"))

               WRITE ?29,$JUSTIFY(ASUMS("RPQ"),7)

 +9        WRITE ?39,"OLD RPQ:"

           IF $GET(ASUMS("RPQ-O"))

               WRITE ?49,$JUSTIFY(ASUMS("RPQ-O"),7)

 +10       WRITE ?61,"SOURCE:",?69,$GET(ASUMS("SRC"))

 +11       WRITE !,"LASTPP:"

           IF $GET(ASUMS("LPP"))

               WRITE ?7,$JUSTIFY(ASUMS("LPP"),10,2)

 +12       WRITE ?19,"LEADTIM:",?29,$JUSTIFY($GET(ASUMS("LTM")),3,1)

 +13       WRITE ?39,"STDPACK:"

           IF $GET(ASUMS("SPQ"))

               WRITE ?49,$JUSTIFY(ASUMS("SPQ"),7)

 +14       WRITE ?61,"VEN U/I:",?71,$GET(ASUMS("VENUI"))

 +15       WRITE !,"EOQ TYP:",?9,$GET(ASUMS("EOQ","TP"))

 +16       WRITE ?11,"EOQ TBL:"

           IF $GET(ASUMS("EOQ","TB"))

               WRITE ?19,$JUSTIFY(ASUMS("EOQ","TB"),4)

 +17       WRITE ?24,"MOS MOD:",?34,$GET(ASUMS("EOQ","MM"))

 +18       WRITE ?39,"QTY MOD:"

           IF $GET(ASUMS("EOQ","QM"))

               WRITE ?48,$JUSTIFY(ASUMS("EOQ","QM"),7)

 +19       WRITE ?61,"ACT MOD:"

           IF $GET(ASUMS("EOQ","AM"))

               WRITE ?69,$JUSTIFY(ASUMS("EOQ","AM"),7)

 +20       QUIT 

DI(ASUMS) ;

 +1       ;----- WRITES DUE IN DATA

 +2       ;

 +3        NEW I

 +4        WRITE !?(IOM-46)/2,"**************** DUE IN DATA *****************"

 +5        FOR I=1:1:3

               Begin DoDot:1

 +6                WRITE !,"DUEIN "_I_" PO:",?12,$GET(ASUMS("D/I","PO#",I))

 +7                WRITE ?21,"DT:"

                   IF $GET(ASUMS("D/I","DT",I))

                       WRITE ?26,$EXTRACT(ASUMS("D/I","DT",I),4,7),$EXTRACT(ASUMS("D/I","DT",I),2,3)