| 1 | ORUS1 ; slc/KCM - Select Items from List ;3/24/92 08:56
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | EN F I=0:0 D INIT R X:DTIME S:'$T X="^" S:X["^"&(X'="^^") DUOUT=1 S:'$L(X) X=ORDFLT S:X["^^" DIROUT=1 S:X["^" Y=-1 Q:'$L(X)!(X["^")!(+$G(ORNOSEL)=1&(X'["?")&(ORUS(0)'["O")) D CHK Q:ORQUIT Q:ORBACK Q:(ORTOT+ORT9)>0 W:ORSEL'["?" $C(7)," ??"
|
|---|
| 5 | Q:ORQUIT Q:ORBACK K Y("B"),OR9Y("B") Q:'$L(X)!(X["^")
|
|---|
| 6 | S:Y>0 (Y,Y(0))=ORTOT
|
|---|
| 7 | W " " S ORTTAB=$X,J=1 I Y>0 K ^DISV(DUZ,ORUS) D SDISV S ^DISV(DUZ,ORUS,0)=X,I=0 F J=1:1 S I=$O(Y(I)) Q:I="" S X=$P(Y(I),"^",3),^DISV(DUZ,ORUS)=+Y(I),^DISV(DUZ,ORUS,J)=X W:($X+$L(X))>(IOM-4) !?ORTTAB W X," "
|
|---|
| 8 | I OR9Y S I=0 F J=J:1 S I=$O(OR9Y(I)) Q:I="" S X=$P(OR9Y(I),"^"),^DISV(DUZ,ORUS,J)=X W:($X+$L(X))>(IOM-4) !?ORTTAB W X," "
|
|---|
| 9 | Q
|
|---|
| 10 | CHK ;
|
|---|
| 11 | I X="+",'$D(OR9(999)) W !," THIS IS THE END OF THE LIST" S ORSEL="?" Q
|
|---|
| 12 | S:X="+" X=999 S ORSEL=X,Y=0
|
|---|
| 13 | I X["?" D EN^ORUS3 Q
|
|---|
| 14 | I X="-" S ORBACK=1,P=$S(P=0:0,1:P-1) Q
|
|---|
| 15 | I X=" " D SPAC Q:+$G(ORTOT)>0
|
|---|
| 16 | S X=$$UPPER^ORU(X)
|
|---|
| 17 | I ORUS(0)["S",X[",",$D(ORUS("ALT")),ORTOT+ORT9'>0,$L(ORSEL) X ORUS("ALT") S:$T ORQUIT=1 Q
|
|---|
| 18 | I ORUS(0)["S",X[","!(X["-")!(X["'") D SING Q
|
|---|
| 19 | F ORSEQ=1:1:$L(ORSEL,",") Q:ORERR S X=$P(ORSEL,",",ORSEQ) D SET D:X["-" RNG Q:ORERR S W=X F K=1:1:$L(W,",") S ORWRK=$P(W,",",K) D EAT I $L(ORWRK) D LOOK^ORUS4 Q:ORERR D PROC^ORUS2 Q:ORERR
|
|---|
| 20 | I $L(ORUS(0),"^")=2,(ORTOT>+$P(ORUS(0),"^",2)) S ORERR=1 W " ONLY "_+$P(ORUS(0),"^",2)_" ITEMS ALLOWED"
|
|---|
| 21 | S:ORERR (ORTOT,ORT9)=0
|
|---|
| 22 | I $D(ORUS("ALT")),ORTOT+ORT9'>0,$L(ORSEL) X ORUS("ALT") S:$T ORQUIT=1 Q
|
|---|
| 23 | Q
|
|---|
| 24 | SET S (ORERR,ORSUB)=0 S:$E(X)["'" ORSUB=1,X=$P(X,"'",2) S:$E(X)["*" X=$P(X,"*",2),X=$S(X["=":X_"*",1:X_"=*") S ORPC=X,ORFLG=$P(X,"=",2),X=$P(X,"=") S:$L(ORFLG) ORFLG="="_ORFLG
|
|---|
| 25 | Q
|
|---|
| 26 | SPAC S ORERR=1 Q:'$D(^DISV(DUZ,ORUS,0)) D SDISV Q:^DISV(DUZ,ORUS,0)'=X
|
|---|
| 27 | S ORSEQ=0 F I=0:0 S ORSEQ=$O(^DISV(DUZ,ORUS,ORSEQ)) Q:ORSEQ'>0 S (X,ORWRK)=^(ORSEQ) D SET,LOOK^ORUS4,PROC^ORUS2
|
|---|
| 28 | S ORERR=0 Q
|
|---|
| 29 | SDISV S X=$S($D(ORUS("L")):ORUS("L"),1:"")_"^"_$S($D(ORUS("S")):ORUS("S"),1:"")_"^"_$S(ORUS(0)["S":1,1:0) ;_"^"_$S(ORUS(0)["A":1,1:0)
|
|---|
| 30 | Q
|
|---|
| 31 | RNG Q:X["E" I X'?.N1"-".N!($P(X,"-",1)'<$P(X,"-",2)) S ORERR=1 Q
|
|---|
| 32 | S W="" F J=$P(X,"-",1):1:$P(X,"-",2) S W=W_J_"," I $L(W)>245 W $C(7)," RANGE OF NUMBERS TOO LARGE." S ORERR=1,ORSEL="?" Q
|
|---|
| 33 | S X=W
|
|---|
| 34 | Q
|
|---|
| 35 | SING W $C(7)," -- ONLY ONE SELECTION ALLOWED." S ORSEL="?" Q
|
|---|
| 36 | EAT F I=0:0 Q:$E(ORWRK)]" " Q:'$L(ORWRK) S ORWRK=$E(ORWRK,2,999)
|
|---|
| 37 | F I=0:0 Q:$E(ORWRK,$L(ORWRK))]" " Q:'$L(ORWRK) S ORWRK=$E(ORWRK,1,$L(ORWRK)-1)
|
|---|
| 38 | F J=1:1:$L(ORWRK) I $A(ORWRK,J)'>31 S ORWRK="" Q
|
|---|
| 39 | Q
|
|---|
| 40 | INIT K Y,OR9Y,ORSEL S (Y,OR9Y,ORBACK,ORERR,ORQUIT,ORTOT,ORT9)=0
|
|---|
| 41 | S ORPRMT=$S($D(ORUS("A")):ORUS("A"),+ORFN:"Select "_ORFNM_": ",1:"Select Item: ")
|
|---|
| 42 | S ORDFLT=$S($D(ORUS("B")):ORUS("B"),1:""),ORMOR=0
|
|---|
| 43 | W !!,ORPRMT,$S($L(ORDFLT):ORDFLT_"// ",1:"")
|
|---|
| 44 | Q
|
|---|
