| 1 | XBGL ;IHS/ITSC/DMJ - GLOBAL LISTER [ 03/17/2005 10:46 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | START ;START HERE
|
|---|
| 4 | K XB,DIR W ! S $Y=1
|
|---|
| 5 | S DIR(0)="FAO^1:80",DIR("A")="Global: ^" D ^DIR K DIR
|
|---|
| 6 | I Y=""!(Y="^") W ! K DIR Q
|
|---|
| 7 | I Y[",,"!(Y["(,") W *7,!!,"Use '*' for wildcard.",! G START
|
|---|
| 8 | I $E(Y,1)'="^" S Y="^"_Y
|
|---|
| 9 | I $L(Y,"(")=2,$P(Y,"(",2)']"" S Y=$P(Y,"(",1)
|
|---|
| 10 | S (XB("Y"),XB("IN"))=Y
|
|---|
| 11 | S XB("RB")=$P(XB("IN"),"(",1)
|
|---|
| 12 | I1 ;SET UP INPUT FOR COMPARISON
|
|---|
| 13 | I XB("IN")["(" D
|
|---|
| 14 | .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
|
|---|
| 15 | .S XB("X")="",XB("Z")=""
|
|---|
| 16 | .S XB("IS")=$P(XB("IN"),"(",2,999)
|
|---|
| 17 | .I $E(XB("IS"),$L(XB("IS")))=")",XB("LP")=XB("RP") S XB("IS")=$E(XB("IS"),1,$L(XB("IS"))-1)
|
|---|
| 18 | .F I=1:1:$L(XB("IS"),",") D
|
|---|
| 19 | ..S XB("I"_I)=$P(XB("IS"),",",I) Q:XB("I"_I)=""
|
|---|
| 20 | ..S X="ER2",@^%ZOSF("TRAP") I 'XB("I"_I),XB("I"_I)'=0,XB("I"_I)'="*",$E(XB("I"_I),1)'=$C(34) D
|
|---|
| 21 | ...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
|
|---|
| 22 | ...S XB("I"_I)=@XB("I"_I)
|
|---|
| 23 | ...I $G(XB("F3")) S XB("I"_I)=XB("I"_I)_":",XB("F3")=0
|
|---|
| 24 | ..S $P(XB("X"),",",I)=XB("I"_I),$P(XB("Z"),",",I)=XB("I"_I)
|
|---|
| 25 | ..I XB("I"_I)="*" S $P(XB("X"),",",I)="0"
|
|---|
| 26 | ..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)="*"
|
|---|
| 27 | .S XB("IN")=XB("RB")_"("_XB("Z")_$S($E(Y,$L(Y))=")"&(XB("RP")=XB("LP")):")",1:""),XB("I")=$L(XB("Z"),",")
|
|---|
| 28 | .S XB("Y")=XB("RB")_"("_XB("X")_")"
|
|---|
| 29 | FIRST ;INITIAL ENTRY
|
|---|
| 30 | S X="ER1",@^%ZOSF("TRAP")
|
|---|
| 31 | I XB("IN")[")",XB("IN")'["*" S XB("F1")=1
|
|---|
| 32 | I $D(@XB("Y"))#2 D DISP I $G(XB("OUT")) G START
|
|---|
| 33 | LOOP ;LOOP HERE
|
|---|
| 34 | S X="ER2",@^%ZOSF("TRAP")
|
|---|
| 35 | F S XB("Y")=$Q(@(XB("Y"))) D MATCH Q:$G(XB("F1")) D DISP I $G(XB("OUT")) G START
|
|---|
| 36 | G START
|
|---|
| 37 | ER1 ;FIRST ERROR CONDITION
|
|---|
| 38 | G LOOP
|
|---|
| 39 | ER2 ;SECOND ERROR CONDITION
|
|---|
| 40 | W *7,!!,"??",! G START
|
|---|
| 41 | MATCH ;DECIPHER INPUT
|
|---|
| 42 | I XB("Y")="" S XB("F1")=1 Q
|
|---|
| 43 | I $P(XB("IN"),"(",2)']"" Q
|
|---|
| 44 | S XB("F2")=0
|
|---|
| 45 | S XB("SB")=$P(XB("Y"),"(",2),XB("SB")=$E(XB("SB"),1,$L(XB("SB"))-1),XB("S")=$L(XB("SB"),",")
|
|---|
| 46 | I $E(XB("IN"),$L(XB("IN")))=")",XB("S")'=XB("I") S XB("F2")=1 Q
|
|---|
| 47 | S XB("*")=0 F I=1:1:XB("I") D
|
|---|
| 48 | .I XB("I"_I)="*" S XB("*")=XB("*")+1 Q
|
|---|
| 49 | .S XB("S"_I)=$P(XB("SB"),",",I)
|
|---|
| 50 | .I XB("I"_I)'=XB("S"_I) D
|
|---|
| 51 | ..S XB("F2")=1
|
|---|
| 52 | ..I 'XB("*") S XB("F1")=1
|
|---|
| 53 | ..I XB("IN")'["*" S XB("F1")=1
|
|---|
| 54 | Q
|
|---|
| 55 | DISP ;OUTPUT
|
|---|
| 56 | Q:$G(XB("F2"))
|
|---|
| 57 | S XB("=")=@(XB("Y"))
|
|---|
| 58 | W !,XB("Y")," = ",XB("=")
|
|---|
| 59 | I $Y>20 D
|
|---|
| 60 | .S DIR(0)="E" D ^DIR K DIR
|
|---|
| 61 | .I 'Y S XB("OUT")=1 Q
|
|---|
| 62 | .W @IOF
|
|---|
| 63 | Q
|
|---|
