64 lines
2.4 KiB
Mathematica
64 lines
2.4 KiB
Mathematica
XBGL ;IHS/ITSC/DMJ - GLOBAL LISTER [ 03/17/2005 10:46 AM ]
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
|
START ;START HERE
|
|
K XB,DIR W ! S $Y=1
|
|
S DIR(0)="FAO^1:80",DIR("A")="Global: ^" D ^DIR K DIR
|
|
I Y=""!(Y="^") W ! K DIR Q
|
|
I Y[",,"!(Y["(,") W *7,!!,"Use '*' for wildcard.",! G START
|
|
I $E(Y,1)'="^" S Y="^"_Y
|
|
I $L(Y,"(")=2,$P(Y,"(",2)']"" S Y=$P(Y,"(",1)
|
|
S (XB("Y"),XB("IN"))=Y
|
|
S XB("RB")=$P(XB("IN"),"(",1)
|
|
I1 ;SET UP INPUT FOR COMPARISON
|
|
I XB("IN")["(" D
|
|
.S (XB("LP"),XB("RP"))=0 F I=1:1:$L(XB("IN")) S:$E(XB("IN"),I)="(" XB("LP")=XB("LP")+1 S:$E(XB("IN"),I)=")" XB("RP")=XB("RP")+1
|
|
.S XB("X")="",XB("Z")=""
|
|
.S XB("IS")=$P(XB("IN"),"(",2,999)
|
|
.I $E(XB("IS"),$L(XB("IS")))=")",XB("LP")=XB("RP") S XB("IS")=$E(XB("IS"),1,$L(XB("IS"))-1)
|
|
.F I=1:1:$L(XB("IS"),",") D
|
|
..S XB("I"_I)=$P(XB("IS"),",",I) Q:XB("I"_I)=""
|
|
..S X="ER2",@^%ZOSF("TRAP") I 'XB("I"_I),XB("I"_I)'=0,XB("I"_I)'="*",$E(XB("I"_I),1)'=$C(34) D
|
|
...I $E(XB("I"_I),$L(XB("I"_I)))=":" S XB("I"_I)=$E(XB("I"_I),1,$L(XB("I"_I))-1),XB("F3")=1
|
|
...S XB("I"_I)=@XB("I"_I)
|
|
...I $G(XB("F3")) S XB("I"_I)=XB("I"_I)_":",XB("F3")=0
|
|
..S $P(XB("X"),",",I)=XB("I"_I),$P(XB("Z"),",",I)=XB("I"_I)
|
|
..I XB("I"_I)="*" S $P(XB("X"),",",I)="0"
|
|
..I $E(XB("I"_I),$L(XB("I"_I)))=":" S $P(XB("Z"),",",I)="*",$P(XB("X"),",",I)=$E(XB("I"_I),1,$L(XB("I"_I))-1),XB("I"_I)="*"
|
|
.S XB("IN")=XB("RB")_"("_XB("Z")_$S($E(Y,$L(Y))=")"&(XB("RP")=XB("LP")):")",1:""),XB("I")=$L(XB("Z"),",")
|
|
.S XB("Y")=XB("RB")_"("_XB("X")_")"
|
|
FIRST ;INITIAL ENTRY
|
|
S X="ER1",@^%ZOSF("TRAP")
|
|
I XB("IN")[")",XB("IN")'["*" S XB("F1")=1
|
|
I $D(@XB("Y"))#2 D DISP I $G(XB("OUT")) G START
|
|
LOOP ;LOOP HERE
|
|
S X="ER2",@^%ZOSF("TRAP")
|
|
F S XB("Y")=$Q(@(XB("Y"))) D MATCH Q:$G(XB("F1")) D DISP I $G(XB("OUT")) G START
|
|
G START
|
|
ER1 ;FIRST ERROR CONDITION
|
|
G LOOP
|
|
ER2 ;SECOND ERROR CONDITION
|
|
W *7,!!,"??",! G START
|
|
MATCH ;DECIPHER INPUT
|
|
I XB("Y")="" S XB("F1")=1 Q
|
|
I $P(XB("IN"),"(",2)']"" Q
|
|
S XB("F2")=0
|
|
S XB("SB")=$P(XB("Y"),"(",2),XB("SB")=$E(XB("SB"),1,$L(XB("SB"))-1),XB("S")=$L(XB("SB"),",")
|
|
I $E(XB("IN"),$L(XB("IN")))=")",XB("S")'=XB("I") S XB("F2")=1 Q
|
|
S XB("*")=0 F I=1:1:XB("I") D
|
|
.I XB("I"_I)="*" S XB("*")=XB("*")+1 Q
|
|
.S XB("S"_I)=$P(XB("SB"),",",I)
|
|
.I XB("I"_I)'=XB("S"_I) D
|
|
..S XB("F2")=1
|
|
..I 'XB("*") S XB("F1")=1
|
|
..I XB("IN")'["*" S XB("F1")=1
|
|
Q
|
|
DISP ;OUTPUT
|
|
Q:$G(XB("F2"))
|
|
S XB("=")=@(XB("Y"))
|
|
W !,XB("Y")," = ",XB("=")
|
|
I $Y>20 D
|
|
.S DIR(0)="E" D ^DIR K DIR
|
|
.I 'Y S XB("OUT")=1 Q
|
|
.W @IOF
|
|
Q
|