ORUS4 ; slc/KCM - Select Items from List ;11/7/90 16:30 ;
;;3.0;ORDER ENTRY/RESULTS REPORTING;**65**;Dec 17, 1997
LOOK K ORFND S (ORFND,ORITM)=0 I $L(ORWRK)>60 S ORERR=1 Q
D L1 I ORITM Q
K ORFND S ORFND=0,A=$E(ORWRK,1,$L(ORWRK)-1)_$C($A($E(ORWRK,$L(ORWRK)))-1)_"~",ORBUF=A
F I=0:0 S A=$O(@(ORLK_"A)")) Q:A="" Q:$E(A,1,$L(ORWRK))'=ORWRK S B="" F I=0:0 S B=$O(@(ORLK_"A,B)")) Q:B="" I '$D(ORFND("B",B)),$D(@(ORUS_"B,0)")) S ORDA=B X ORSC I $T,$D(@(ORUS_"B,0)")) X ORWR I $L(X) D SFND
S A=ORBUF F I=0:0 S A=$O(@(ORUS_"""B"",A)")) Q:A="" Q:$E(A,1,$L(ORWRK))'=ORWRK S B="" F I=0:0 S B=$O(@(ORUS_"""B"",A,B)")) Q:B="" I '$D(ORFND("B",B)),$D(@(ORUS_"B,0)")) S ORDA=B X ORSC I $T,$D(@(ORUS_"B,0)")) X ORWR I $L(X) D SFND
I $D(OR9)>0 S A=ORBUF F I=0:0 S A=$O(OR9("B",A)) Q:A="" Q:$E(A,1,$L(ORWRK))'=ORWRK S B=$O(OR9("B",A,0)) I $L(B),'$D(ORFND("B",B)) S ORFND=ORFND+1,ORFND(ORFND)=B_"^"_$P(OR9(B),"^")_"^9",ORFND("B",B)=""
I $D(OR9),ORWRK?.N,$D(OR9("B",ORWRK)) S B=$O(OR9("B",+ORWRK,0)) I $L(B),'$D(ORFND("B",B)) S ORFND=ORFND+1,ORFND(ORFND)=B_"^"_$P(OR9(B),"^")_"^9",ORFND("B",B)=""
I (ORSEL?1A.A1","1A.A.1" ".A),(ORFND=0) S ORERR=1
L1 I ORWRK?.N,ORUS(0)["N",$D(^XUTL("OR",$J,"ORW",ORWRK)) S ORDA=^(ORWRK) I '$D(ORFND("B",ORDA)),$D(@(ORUS_"ORDA,0)")) X ORWR S ORFND=ORFND+1,ORFND(ORFND)=ORDA_"^"_X_"^0",ORFND("B",ORDA)=""
S ORITM=0
I ORFND=1 S ORITM=ORFND(1) K ORFND Q
I ORFND=0,X="ALL" D:ORUS(0)["S" SING^ORUS1 S:ORUS(0)'["S" ORITM=-1 Q
I ORFND>0 D CHOOZ
Q
CHOOZ S ORBUF=X F J=1:1:ORFND W !,$J(J,6),?9,$P(ORFND(J),"^",2)
F I=0:0 W !,$S(ORSEL[","!(ORSEL["-"):"For entry """_ORWRK_""" ",1:""),"CHOOSE 1-",ORFND,": " R X:DTIME S:'$T X="^" S:X["^^" DIROUT=1 S:'$L(X)!(X["^") ORERR=1 Q:X'["?" W !!,"Enter a number from 1 to ",ORFND," or type another selection.",!
Q:ORERR
I $D(ORFND(X)) S ORITM=ORFND(X),X=ORBUF K ORFND Q
K ORFND S ORWRK=X D LOOK
Q
SFND S ORFND=ORFND+1,ORFND(ORFND)=ORDA_"^"_X_"^0",ORFND("B",ORDA)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUS4 1961 printed Nov 22, 2024@17:44:31 Page 2
ORUS4 ; slc/KCM - Select Items from List ;11/7/90 16:30 ;
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**65**;Dec 17, 1997
LOOK KILL ORFND
SET (ORFND,ORITM)=0
IF $LENGTH(ORWRK)>60
SET ORERR=1
QUIT
+1 DO L1
IF ORITM
QUIT
+2 KILL ORFND
SET ORFND=0
SET A=$EXTRACT(ORWRK,1,$LENGTH(ORWRK)-1)_$CHAR($ASCII($EXTRACT(ORWRK,$LENGTH(ORWRK)))-1)_"~"
SET ORBUF=A
+3 FOR I=0:0
SET A=$ORDER(@(ORLK_"A)"))
if A=""
QUIT
if $EXTRACT(A,1,$LENGTH(ORWRK))'=ORWRK
QUIT
SET B=""
FOR I=0:0
SET B=$ORDER(@(ORLK_"A,B)"))
if B=""
QUIT
IF '$DATA(ORFND("B",B))
IF $DATA(@(ORUS_"B,0)"))
SET ORDA=B
XECUTE ORSC
IF $TEST
IF $DATA(@(ORUS_"B,0)"))
XECUTE ORWR
IF $LENGTH(X)
DO SFND
+4 SET A=ORBUF
FOR I=0:0
SET A=$ORDER(@(ORUS_"""B"",A)"))
if A=""
QUIT
if $EXTRACT(A,1,$LENGTH(ORWRK))'=ORWRK
QUIT
SET B=""
FOR I=0:0
SET B=$ORDER(@(ORUS_"""B"",A,B)"))
if B=""
QUIT
IF '$DATA(ORFND("B",B))
IF $DATA(@(ORUS_"B,0)"))
SET ORDA=B
XECUTE ORSC
IF $TEST
IF $DATA(@(ORUS_"B,0)"))
XECUTE ORWR
IF $LENGTH(X)
DO SFND
+5 IF $DATA(OR9)>0
SET A=ORBUF
FOR I=0:0
SET A=$ORDER(OR9("B",A))
if A=""
QUIT
if $EXTRACT(A,1,$LENGTH(ORWRK))'=ORWRK
QUIT
SET B=$ORDER(OR9("B",A,0))
IF $LENGTH(B)
IF '$DATA(ORFND("B",B))
SET ORFND=ORFND+1
SET ORFND(ORFND)=B_"^"_$PIECE(OR9(B),"^")_"^9"
SET ORFND("B",B)=""
+6 IF $DATA(OR9)
IF ORWRK?.N
IF $DATA(OR9("B",ORWRK))
SET B=$ORDER(OR9("B",+ORWRK,0))
IF $LENGTH(B)
IF '$DATA(ORFND("B",B))
SET ORFND=ORFND+1
SET ORFND(ORFND)=B_"^"_$PIECE(OR9(B),"^")_"^9"
SET ORFND("B",B)=""
+7 IF (ORSEL?1A.A1","1A.A.1" ".A)
IF (ORFND=0)
SET ORERR=1
L1 IF ORWRK?.N
IF ORUS(0)["N"
IF $DATA(^XUTL("OR",$JOB,"ORW",ORWRK))
SET ORDA=^(ORWRK)
IF '$DATA(ORFND("B",ORDA))
IF $DATA(@(ORUS_"ORDA,0)"))
XECUTE ORWR
SET ORFND=ORFND+1
SET ORFND(ORFND)=ORDA_"^"_X_"^0"
SET ORFND("B",ORDA)=""
+1 SET ORITM=0
+2 IF ORFND=1
SET ORITM=ORFND(1)
KILL ORFND
QUIT
+3 IF ORFND=0
IF X="ALL"
if ORUS(0)["S"
DO SING^ORUS1
if ORUS(0)'["S"
SET ORITM=-1
QUIT
+4 IF ORFND>0
DO CHOOZ
+5 QUIT
CHOOZ SET ORBUF=X
FOR J=1:1:ORFND
WRITE !,$JUSTIFY(J,6),?9,$PIECE(ORFND(J),"^",2)
+1 FOR I=0:0
WRITE !,$SELECT(ORSEL[","!(ORSEL["-"):"For entry """_ORWRK_""" ",1:""),"CHOOSE 1-",ORFND,": "
READ X:DTIME
if '$TEST
SET X="^"
if X["^^"
SET DIROUT=1
if '$LENGTH(X)!(X["^")
SET ORERR=1
if X'["?"
QUIT
WRITE !!,"Enter a number from 1 to ",ORFND," or type another selection.",!
+2 if ORERR
QUIT
+3 IF $DATA(ORFND(X))
SET ORITM=ORFND(X)
SET X=ORBUF
KILL ORFND
QUIT
+4 KILL ORFND
SET ORWRK=X
DO LOOK
+5 QUIT
SFND SET ORFND=ORFND+1
SET ORFND(ORFND)=ORDA_"^"_X_"^0"
SET ORFND("B",ORDA)=""
+1 QUIT
