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
