ASUAUTIL.m

ASUAUTIL ;DSD/DFM -UTILITY SUB-ROUTINES;  [ 04/15/98  2:55 PM ]

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

ARPRINT ;EP; Write out Area Name and save Area Lookup table EIN

 D ARL W " ",ASUK("AREA NAME") Q

AREA ;EP - Lookup Area Name. X=AREA CODE

 S ASUF("LOOKA")=$G(ASUF("LOOKA"))

 S:ASUF("LOOKA")="" ASUF("LOOKA")=1

 I $D(ASUK("AREA","ACCPT")) G ARL

 I ASUF("LOOKA"),'$D(X) D SETAREA^ASUAUARE S ASUF("LOOKA")=0 G ARX

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

ARL ;

 S ASUK("TR1","AREA")=$O(^ASUTB01("B",ASUK("AREA","ACCPT"),0))

 S ASUK("AREA NAME")=$S(ASUK("TR1","AREA")]"":$P(^ASUTB01(ASUK("TR1","AREA"),0),U,2),1:"")

 S ASUF("LOOKA")=$G(ASUF("LOOKA"))

 D:ASUF("LOOKA") LOOKUP^ASUAUARE

ARX ;

 Q

STPRINT ;

 D STL W " ",ASUK("STATION","NAME") Q

STAT ;EP - Lookup Station Name. X=AREA CODE, X1=STATION CODE.

 I $D(ASUK("AREA","ACCPT")) G STK

 I '$D(X) D  G STK

 .S X=$G(ASUK("AREA","ACCPT")) D:X="" SETAREA^ASUAUARE

 S ASUK("AREA","ACCPT")=X D ARL

STK ;

 I $D(ASUK("STATION","CODE")) G STL

 I '$D(X1) S (ASUK("STATION","CODE"),ASUK("STATION","NAME"))="" G STX

 S ASUK("STATION","CODE")=X1

STL ;

 S ASUK("TR1","STATION")=$O(^ASUTB01(ASUK("TR1","AREA"),1,"B",ASUK("STATION","CODE"),0))

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

STX ;      

 Q

GL ;EP - Lookup GL Account Name. X=GL CODE

 S ASUK("ACCOUNT NAME")=$S($O(^ASUTBLA("B",X,0)):$P(^ASUTBLA($O(^ASUTBLA("B",X,0)),0),U,3),1:"")

 Q

ITEM ;EP - Lookup item Description 1 & 2. X=INDEX NUMBER.

 S (ASUIXM("DESCRIPTION1"),ASUIXM("DESCRIPTION2"))=""

 Q:'X

 Q:$L($O(^ASUINDX("B",X,0)))=0

 S X=$O(^ASUINDX("B",X,0))

 S ASUIXM("DESCRIPTION1")=$P(^ASUINDX(X,0),U,2)

 S ASUIXM("DESCRIPTION2")=$P(^ASUINDX(X,0),U,3)

 Q

LOGV ;EP; SAVE OR PRINT INVENTORY LOG DATA

 S:'$D(ASUK("PRINT QUEUED")) ASUK("PRINT QUEUED")=0

 I ASUK("PRINT QUEUED") D

 .S ASUK("LOG VLIN")=$G(ASUK("LOG VLIN"))+1

 .S ^ASUX(0,"V",ASUK("LOG VLIN"))=ASUTRX

 E  D

 .D:'$D(IO(0)) HOME^%ZIS U IO(0)

 .X ASUTRX

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

 Q

LOG ;EP; SAVE OR PRINT LOG DATA

 S ASUK("LOG LINE")=$G(ASUK("LOG LINE"))+1

 S ^ASUX(0,ASUK("LOG LINE"))=ASUTRX

 S:'$D(ASUK("PRINT QUEUED")) ASUK("PRINT QUEUED")=0

 I ASUK("PRINT QUEUED") Q

 D:'$D(IO(0)) HOME^%ZIS U IO(0)

 X ASUTRX

 Q

PVLOG ;EP - QUEUED JOB LISTING

 I '$D(^ASUX(0,"V")) Q

 D CLS^ASUAULGO

 W !!,"The following are SAMS Inventory System messages from Queued Jobs:",!!

 F  S ASUK("LOG VLIN")=$O(^ASUX(0,"V",$G(ASUK("LOG VLIN")))) Q:ASUK("LOG VLIN")']""  D

 .X ^ASUX(0,"V",ASUK("LOG VLIN"))

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

 W !!,"ALL MESSAGES HAVE BEEN PRINTED",!!

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

 K ^ASUX(0,"V"),ASUK("LOG VLIN")

 Q

COMDN ;EP - SET SIGN NEGATIVE, INSERT DECIMALS AND COMMAS

 I X'["." D

 .I $L(X)=1 D

 ..S X=".0"_X

 .E  D

 ..I $L(X)=2 D

 ...S X="."_X

 ..E  D

 ...D INDC

 S X=X*-1

 D COM

 Q

COMD ;EP - INSERT DECIMAL & COMMAS

 I X'["." D

 .D INDC

 D COM

 Q

COMN ;EP - SET SIGN NEGATIVE INSERT COMMAS

 S X=X*-1 D COM Q

COM ;EP - INSERT COMMAS & RIGHT JUSTIFY (X2 = # DECIMAL, X3 = SIZE OF OUTPUT)

 S:'$D(X2) X2=2

 S:'$D(X3) X3=12

 S X=$FN(X,"T,",X2)

 S X=$J(X,X3)

 Q

INDC ;EP INSERT DECIMAL POINT (IF NO X2, DEFAULT IS 2 PLACES)

 S:'$D(X2) X2=2

 I $L(X)<X2 S X4=$E("00000",1,X2-$L(X)),X="."_X4_X Q

 S X=$E(X,1,$L(X)-X2)_"."_$E(X,$L(X)-(X2-1),$L(X))

 Q

RND2D ;EP TO ROUND TO TWO DECIMAL PLACES

 S Y=$FN(X,"T",2) Q

RND0D ;EP TO ROUND TO WHOLE NUMBER

 S Y=$FN(X,"T",0)

PHONE ;EP INPUT TRANSFORM FOR A PHONE NUMBER

 D

 .I $L(X)>8 D

 ..I X'?1"(".3N.1") ".3N.1"-".4N K X

 .E  D

 ..I X'?3N.1"-".4N K X

 Q

ASUAUTIL  ;DSD/DFM -UTILITY SUB-ROUTINES;  [ 04/15/98  2:55 PM ]

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

ARPRINT   ;EP; Write out Area Name and save Area Lookup table EIN

 +1        DO ARL

           WRITE " ",ASUK("AREA NAME")

           QUIT 

AREA      ;EP - Lookup Area Name. X=AREA CODE

 +1        SET ASUF("LOOKA")=$GET(ASUF("LOOKA"))

 +2        IF ASUF("LOOKA")=""

               SET ASUF("LOOKA")=1

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

               GOTO ARL

 +4        IF ASUF("LOOKA")

               IF '$DATA(X)

                   DO SETAREA^ASUAUARE

                   SET ASUF("LOOKA")=0

                   GOTO ARX

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

ARL       ;

 +1        SET ASUK("TR1","AREA")=$ORDER(^ASUTB01("B",ASUK("AREA","ACCPT"),0))

 +2        SET ASUK("AREA NAME")=$SELECT(ASUK("TR1","AREA")]"":$PIECE(^ASUTB01(ASUK("TR1","AREA"),0),U,2),1:"")

 +3        SET ASUF("LOOKA")=$GET(ASUF("LOOKA"))

 +4        IF ASUF("LOOKA")

               DO LOOKUP^ASUAUARE

ARX       ;

 +1        QUIT 

STPRINT   ;

 +1        DO STL

           WRITE " ",ASUK("STATION","NAME")

           QUIT 

STAT      ;EP - Lookup Station Name. X=AREA CODE, X1=STATION CODE.

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

               GOTO STK

 +2        IF '$DATA(X)

               Begin DoDot:1

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

                   IF X=""

                       DO SETAREA^ASUAUARE

               End DoDot:1

               GOTO STK

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

           DO ARL

STK       ;

 +1        IF $DATA(ASUK("STATION","CODE"))

               GOTO STL

 +2        IF '$DATA(X1)

               SET (ASUK("STATION","CODE"),ASUK("STATION","NAME"))=""

               GOTO STX

 +3        SET ASUK("STATION","CODE")=X1

STL       ;

 +1        SET ASUK("TR1","STATION")=$ORDER(^ASUTB01(ASUK("TR1","AREA"),1,"B",ASUK("STATION","CODE"),0))

 +2        SET ASUK("STATION","NAME")=$SELECT(ASUK("TR1","STATION")]"":$PIECE(^ASUTB01(ASUK("TR1","AREA"),1,ASUK("TR1","STATION"),0),U,2),1:"")

STX       ;      

 +1        QUIT 

GL        ;EP - Lookup GL Account Name. X=GL CODE

 +1        SET ASUK("ACCOUNT NAME")=$SELECT($ORDER(^ASUTBLA("B",X,0)):$PIECE(^ASUTBLA($ORDER(^ASUTBLA("B",X,0)),0),U,3),1:"")

 +2        QUIT 

ITEM      ;EP - Lookup item Description 1 & 2. X=INDEX NUMBER.

 +1        SET (ASUIXM("DESCRIPTION1"),ASUIXM("DESCRIPTION2"))=""

 +2        IF 'X

               QUIT 

 +3        IF $LENGTH($ORDER(^ASUINDX("B",X,0)))=0

               QUIT 

 +4        SET X=$ORDER(^ASUINDX("B",X,0))

 +5        SET ASUIXM("DESCRIPTION1")=$PIECE(^ASUINDX(X,0),U,2)

 +6        SET ASUIXM("DESCRIPTION2")=$PIECE(^ASUINDX(X,0),U,3)

 +7        QUIT 

LOGV      ;EP; SAVE OR PRINT INVENTORY LOG DATA

 +1        IF '$DATA(ASUK("PRINT QUEUED"))

               SET ASUK("PRINT QUEUED")=0

 +2        IF ASUK("PRINT QUEUED")

               Begin DoDot:1

 +3                SET ASUK("LOG VLIN")=$GET(ASUK("LOG VLIN"))+1

 +4                SET ^ASUX(0,"V",ASUK("LOG VLIN"))=ASUTRX

               End DoDot:1

 +5       IF '$TEST

               Begin DoDot:1

 +6                IF '$DATA(IO(0))

                       DO HOME^%ZIS

                   USE IO(0)

 +7                XECUTE ASUTRX

 +8                SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

 +9        QUIT 

LOG       ;EP; SAVE OR PRINT LOG DATA

 +1        SET ASUK("LOG LINE")=$GET(ASUK("LOG LINE"))+1

 +2        SET ^ASUX(0,ASUK("LOG LINE"))=ASUTRX

 +3        IF '$DATA(ASUK("PRINT QUEUED"))

               SET ASUK("PRINT QUEUED")=0

 +4        IF ASUK("PRINT QUEUED")

               QUIT 

 +5        IF '$DATA(IO(0))

               DO HOME^%ZIS

           USE IO(0)

 +6        XECUTE ASUTRX

 +7        QUIT 

PVLOG     ;EP - QUEUED JOB LISTING

 +1        IF '$DATA(^ASUX(0,"V"))

               QUIT 

 +2        DO CLS^ASUAULGO

 +3        WRITE !!,"The following are SAMS Inventory System messages from Queued Jobs:",!!

 +4        FOR 

               SET ASUK("LOG VLIN")=$ORDER(^ASUX(0,"V",$GET(ASUK("LOG VLIN"))))

               IF ASUK("LOG VLIN")']""

                   QUIT 

               Begin DoDot:1

 +5                XECUTE ^ASUX(0,"V",ASUK("LOG VLIN"))

 +6                SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

 +7        WRITE !!,"ALL MESSAGES HAVE BEEN PRINTED",!!

 +8        SET DIR(0)="E"

           DO ^DIR

           KILL DIR

 +9        KILL ^ASUX(0,"V"),ASUK("LOG VLIN")

 +10       QUIT 

COMDN     ;EP - SET SIGN NEGATIVE, INSERT DECIMALS AND COMMAS

 +1        IF X'["."

               Begin DoDot:1

 +2                IF $LENGTH(X)=1

                       Begin DoDot:2

 +3                        SET X=".0"_X

                       End DoDot:2

 +4               IF '$TEST

                       Begin DoDot:2

 +5                        IF $LENGTH(X)=2

                               Begin DoDot:3

 +6                                SET X="."_X

                               End DoDot:3

 +7                       IF '$TEST

                               Begin DoDot:3

 +8                                DO INDC

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +9        SET X=X*-1

 +10       DO COM

 +11       QUIT 

COMD      ;EP - INSERT DECIMAL & COMMAS

 +1        IF X'["."

               Begin DoDot:1

 +2                DO INDC

               End DoDot:1

 +3        DO COM

 +4        QUIT 

COMN      ;EP - SET SIGN NEGATIVE INSERT COMMAS

 +1        SET X=X*-1

           DO COM

           QUIT 

COM       ;EP - INSERT COMMAS & RIGHT JUSTIFY (X2 = # DECIMAL, X3 = SIZE OF OUTPUT)

 +1        IF '$DATA(X2)

               SET X2=2

 +2        IF '$DATA(X3)

               SET X3=12

 +3        SET X=$FNUMBER(X,"T,",X2)

 +4        SET X=$JUSTIFY(X,X3)

 +5        QUIT 

INDC      ;EP INSERT DECIMAL POINT (IF NO X2, DEFAULT IS 2 PLACES)

 +1        IF '$DATA(X2)

               SET X2=2

 +2        IF $LENGTH(X)<X2

               SET X4=$EXTRACT("00000",1,X2-$LENGTH(X))

               SET X="."_X4_X

               QUIT 

 +3        SET X=$EXTRACT(X,1,$LENGTH(X)-X2)_"."_$EXTRACT(X,$LENGTH(X)-(X2-1),$LENGTH(X))

 +4        QUIT 

RND2D     ;EP TO ROUND TO TWO DECIMAL PLACES

 +1        SET Y=$FNUMBER(X,"T",2)

           QUIT 

RND0D     ;EP TO ROUND TO WHOLE NUMBER

 +1        SET Y=$FNUMBER(X,"T",0)

PHONE     ;EP INPUT TRANSFORM FOR A PHONE NUMBER

 +1        Begin DoDot:1

 +2            IF $LENGTH(X)>8

                   Begin DoDot:2

 +3                    IF X'?1"(".3N.1") ".3N.1"-".4N

                           KILL X

                   End DoDot:2

 +4           IF '$TEST

                   Begin DoDot:2

 +5                    IF X'?3N.1"-".4N

                           KILL X

                   End DoDot:2

           End DoDot:1

 +6        QUIT