- ORUS1 ; slc/KCM - Select Items from List ;3/24/92 08:56
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- ;
- 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)," ??"
- Q:ORQUIT Q:ORBACK K Y("B"),OR9Y("B") Q:'$L(X)!(X["^")
- S:Y>0 (Y,Y(0))=ORTOT
- 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," "
- 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," "
- Q
- CHK ;
- I X="+",'$D(OR9(999)) W !," THIS IS THE END OF THE LIST" S ORSEL="?" Q
- S:X="+" X=999 S ORSEL=X,Y=0
- I X["?" D EN^ORUS3 Q
- I X="-" S ORBACK=1,P=$S(P=0:0,1:P-1) Q
- I X=" " D SPAC Q:+$G(ORTOT)>0
- S X=$$UPPER^ORU(X)
- I ORUS(0)["S",X[",",$D(ORUS("ALT")),ORTOT+ORT9'>0,$L(ORSEL) X ORUS("ALT") S:$T ORQUIT=1 Q
- I ORUS(0)["S",X[","!(X["-")!(X["'") D SING Q
- 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
- I $L(ORUS(0),"^")=2,(ORTOT>+$P(ORUS(0),"^",2)) S ORERR=1 W " ONLY "_+$P(ORUS(0),"^",2)_" ITEMS ALLOWED"
- S:ORERR (ORTOT,ORT9)=0
- I $D(ORUS("ALT")),ORTOT+ORT9'>0,$L(ORSEL) X ORUS("ALT") S:$T ORQUIT=1 Q
- Q
- 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
- Q
- SPAC S ORERR=1 Q:'$D(^DISV(DUZ,ORUS,0)) D SDISV Q:^DISV(DUZ,ORUS,0)'=X
- 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
- S ORERR=0 Q
- 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)
- Q
- RNG Q:X["E" I X'?.N1"-".N!($P(X,"-",1)'<$P(X,"-",2)) S ORERR=1 Q
- 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
- S X=W
- Q
- SING W $C(7)," -- ONLY ONE SELECTION ALLOWED." S ORSEL="?" Q
- EAT F I=0:0 Q:$E(ORWRK)]" " Q:'$L(ORWRK) S ORWRK=$E(ORWRK,2,999)
- F I=0:0 Q:$E(ORWRK,$L(ORWRK))]" " Q:'$L(ORWRK) S ORWRK=$E(ORWRK,1,$L(ORWRK)-1)
- F J=1:1:$L(ORWRK) I $A(ORWRK,J)'>31 S ORWRK="" Q
- Q
- INIT K Y,OR9Y,ORSEL S (Y,OR9Y,ORBACK,ORERR,ORQUIT,ORTOT,ORT9)=0
- S ORPRMT=$S($D(ORUS("A")):ORUS("A"),+ORFN:"Select "_ORFNM_": ",1:"Select Item: ")
- S ORDFLT=$S($D(ORUS("B")):ORUS("B"),1:""),ORMOR=0
- W !!,ORPRMT,$S($L(ORDFLT):ORDFLT_"// ",1:"")
- Q
- ORUS1 ; slc/KCM - Select Items from List ;3/24/92 08:56
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- +2 ;
- EN FOR I=0:0
- DO INIT
- READ X:DTIME
- IF '$TEST
- SET X="^"
- IF X["^"&(X'="^^")
- SET DUOUT=1
- IF '$LENGTH(X)
- SET X=ORDFLT
- IF X["^^"
- SET DIROUT=1
- IF X["^"
- SET Y=-1
- IF '$LENGTH(X)!(X["^")!(+$GET(ORNOSEL)=1&(X'["?")&(ORUS(0)'["O"))
- QUIT
- DO CHK
- IF ORQUIT
- QUIT
- IF ORBACK
- QUIT
- IF (ORTOT+ORT9)>0
- QUIT
- IF ORSEL'["?"
- WRITE $CHAR(7)," ??"
- +1 IF ORQUIT
- QUIT
- IF ORBACK
- QUIT
- KILL Y("B"),OR9Y("B")
- IF '$LENGTH(X)!(X["^")
- QUIT
- +2 IF Y>0
- SET (Y,Y(0))=ORTOT
- +3 WRITE " "
- SET ORTTAB=$X
- SET J=1
- IF Y>0
- KILL ^DISV(DUZ,ORUS)
- DO SDISV
- SET ^DISV(DUZ,ORUS,0)=X
- SET I=0
- FOR J=1:1
- SET I=$ORDER(Y(I))
- IF I=""
- QUIT
- SET X=$PIECE(Y(I),"^",3)
- SET ^DISV(DUZ,ORUS)=+Y(I)
- SET ^DISV(DUZ,ORUS,J)=X
- IF ($X+$LENGTH(X))>(IOM-4)
- WRITE !?ORTTAB
- WRITE X," "
- +4 IF OR9Y
- SET I=0
- FOR J=J:1
- SET I=$ORDER(OR9Y(I))
- IF I=""
- QUIT
- SET X=$PIECE(OR9Y(I),"^")
- SET ^DISV(DUZ,ORUS,J)=X
- IF ($X+$LENGTH(X))>(IOM-4)
- WRITE !?ORTTAB
- WRITE X," "
- +5 QUIT
- CHK ;
- +1 IF X="+"
- IF '$DATA(OR9(999))
- WRITE !," THIS IS THE END OF THE LIST"
- SET ORSEL="?"
- QUIT
- +2 IF X="+"
- SET X=999
- SET ORSEL=X
- SET Y=0
- +3 IF X["?"
- DO EN^ORUS3
- QUIT
- +4 IF X="-"
- SET ORBACK=1
- SET P=$SELECT(P=0:0,1:P-1)
- QUIT
- +5 IF X=" "
- DO SPAC
- IF +$GET(ORTOT)>0
- QUIT
- +6 SET X=$$UPPER^ORU(X)
- +7 IF ORUS(0)["S"
- IF X[","
- IF $DATA(ORUS("ALT"))
- IF ORTOT+ORT9'>0
- IF $LENGTH(ORSEL)
- XECUTE ORUS("ALT")
- IF $TEST
- SET ORQUIT=1
- QUIT
- +8 IF ORUS(0)["S"
- IF X[","!(X["-")!(X["'")
- DO SING
- QUIT
- +9 FOR ORSEQ=1:1:$LENGTH(ORSEL,",")
- IF ORERR
- QUIT
- SET X=$PIECE(ORSEL,",",ORSEQ)
- DO SET
- IF X["-"
- DO RNG
- IF ORERR
- QUIT
- SET W=X
- FOR K=1:1:$LENGTH(W,",")
- SET ORWRK=$PIECE(W,",",K)
- DO EAT
- IF $LENGTH(ORWRK)
- DO LOOK^ORUS4
- IF ORERR
- QUIT
- DO PROC^ORUS2
- IF ORERR
- QUIT
- +10 IF $LENGTH(ORUS(0),"^")=2
- IF (ORTOT>+$PIECE(ORUS(0),"^",2))
- SET ORERR=1
- WRITE " ONLY "_+$PIECE(ORUS(0),"^",2)_" ITEMS ALLOWED"
- +11 IF ORERR
- SET (ORTOT,ORT9)=0
- +12 IF $DATA(ORUS("ALT"))
- IF ORTOT+ORT9'>0
- IF $LENGTH(ORSEL)
- XECUTE ORUS("ALT")
- IF $TEST
- SET ORQUIT=1
- QUIT
- +13 QUIT
- SET SET (ORERR,ORSUB)=0
- IF $EXTRACT(X)["'"
- SET ORSUB=1
- SET X=$PIECE(X,"'",2)
- IF $EXTRACT(X)["*"
- SET X=$PIECE(X,"*",2)
- SET X=$SELECT(X["=":X_"*",1:X_"=*")
- SET ORPC=X
- SET ORFLG=$PIECE(X,"=",2)
- SET X=$PIECE(X,"=")
- IF $LENGTH(ORFLG)
- SET ORFLG="="_ORFLG
- +1 QUIT
- SPAC SET ORERR=1
- IF '$DATA(^DISV(DUZ,ORUS,0))
- QUIT
- DO SDISV
- IF ^DISV(DUZ,ORUS,0)'=X
- QUIT
- +1 SET ORSEQ=0
- FOR I=0:0
- SET ORSEQ=$ORDER(^DISV(DUZ,ORUS,ORSEQ))
- IF ORSEQ'>0
- QUIT
- SET (X,ORWRK)=^(ORSEQ)
- DO SET
- DO LOOK^ORUS4
- DO PROC^ORUS2
- +2 SET ORERR=0
- QUIT
- SDISV ;_"^"_$S(ORUS(0)["A":1,1:0)
- SET X=$SELECT($DATA(ORUS("L")):ORUS("L"),1:"")_"^"_$SELECT($DATA(ORUS("S")):ORUS("S"),1:"")_"^"_$SELECT(ORUS(0)["S":1,1:0)
- +1 QUIT
- RNG IF X["E"
- QUIT
- IF X'?.N1"-".N!($PIECE(X,"-",1)'<$PIECE(X,"-",2))
- SET ORERR=1
- QUIT
- +1 SET W=""
- FOR J=$PIECE(X,"-",1):1:$PIECE(X,"-",2)
- SET W=W_J_","
- IF $LENGTH(W)>245
- WRITE $CHAR(7)," RANGE OF NUMBERS TOO LARGE."
- SET ORERR=1
- SET ORSEL="?"
- QUIT
- +2 SET X=W
- +3 QUIT
- SING WRITE $CHAR(7)," -- ONLY ONE SELECTION ALLOWED."
- SET ORSEL="?"
- QUIT
- EAT FOR I=0:0
- IF $EXTRACT(ORWRK)]" "
- QUIT
- IF '$LENGTH(ORWRK)
- QUIT
- SET ORWRK=$EXTRACT(ORWRK,2,999)
- +1 FOR I=0:0
- IF $EXTRACT(ORWRK,$LENGTH(ORWRK))]" "
- QUIT
- IF '$LENGTH(ORWRK)
- QUIT
- SET ORWRK=$EXTRACT(ORWRK,1,$LENGTH(ORWRK)-1)
- +2 FOR J=1:1:$LENGTH(ORWRK)
- IF $ASCII(ORWRK,J)'>31
- SET ORWRK=""
- QUIT
- +3 QUIT
- INIT KILL Y,OR9Y,ORSEL
- SET (Y,OR9Y,ORBACK,ORERR,ORQUIT,ORTOT,ORT9)=0
- +1 SET ORPRMT=$SELECT($DATA(ORUS("A")):ORUS("A"),+ORFN:"Select "_ORFNM_": ",1:"Select Item: ")
- +2 SET ORDFLT=$SELECT($DATA(ORUS("B")):ORUS("B"),1:"")
- SET ORMOR=0
- +3 WRITE !!,ORPRMT,$SELECT($LENGTH(ORDFLT):ORDFLT_"// ",1:"")
- +4 QUIT
