ORUS ; slc/KCM - Display List of Items ; 12/4/09 5:03pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**91,322**;Dec 17, 1997;Build 15
;
EN S Y=-1 Q:'$D(ORUS)!('$D(ORUS(0))) S:'($D(IO)#2) IO="HOME" I 'IO S IOP=$S($D(ORIO):ORIO,1:"") D ^%ZIS
D INIT^ORUS5
I ORUS(0)["M" F I=0:0 D HDR,MOVE^ORUS5,SHOW,EN^ORUS1 I 'ORBACK Q:'ORMOR Q:ORQUIT
I ORUS(0)'["M" D:ORUS(0)["N" SORB D SORB1,EN^ORUS1
END K %,A,B,J,K,L,M,N,O,OR9,OR9Y,ORBACK,ORBUF,ORCO,ORCW,ORDA,ORDFLT,OREN,ORENL,ORENLA,ORERR,ORFLG,ORFN,ORFND,ORFNM,ORHL,ORITM,ORLK,ORMOR,ORNC,ORND,ORNE,ORNOSEL,OROD,ORPC,ORPRMT,ORPTR,ORQUIT,ORSC
K ORUS,ORSEL,ORSEQ,ORSEQL,ORSUB,ORT9,ORTTAB,ORTB,ORTOT,ORWR,ORWRK,P,S,W,X,^XUTL("OR",$J,"ORU"),^("ORV"),^("ORW")
Q
SHOW S L=0 ;changed 9/18/00 by CLA for OR*3*91:
N ORTXT
F S L=$O(^XUTL("OR",$J,"ORV",P,L)) Q:L>ORCO!(L="") D
. W ! F J=0:1:ORNC-1 S X=L+(J*ORCO) I $D(^XUTL("OR",$J,"ORV",P,X)) D
.. W ?(J*ORTB),$P(^XUTL("OR",$J,"ORV",P,X),"^",2),?(J*ORTB+5)
.. S ORTXT=$E($P(^XUTL("OR",$J,"ORV",P,X),"^"),1,ORTB-5)
.. F Q:'(ORTXT["|SP") S ORTXT=$P(ORTXT,"|",1)_$$SPACE(+$P($P(ORTXT,"|",2),"SP",2))_$P(ORTXT,"|",3,999)
.. W ORTXT
.. I ^(X)="MORE...^+",'$D(OR9("+")) S I="+",OR9(I)=^(X) D S91 ;DJE/VM *322 replace 999 with +
Q
HDR S (DX,DY)=0 X ^%ZOSF("XY") X:$D(ORUS("T")) ORUS("T") S ORHL=$Y K DX,DY Q
S9 S OR9(I)=ORUS(900,I) S:'$L($P(OR9(I),"^",2)) $P(OR9(I),"^",2)=900+I
S91 S:$L($P(OR9(I),"^",1)) OR9("B",$P(OR9(I),"^",1),I)="" S:$L($P(OR9(I),"^",2)) OR9("B",$P(OR9(I),"^",2),I)=""
Q
SORB I 'OREN S O=OROD,A="",S=0 F I=0:0 S A=$O(@(O_"A)")) Q:A="" S B="" F S B=$O(@(O_"A,B)")) Q:B="" I $D(@(ORUS_"B,0)")) S ORDA=B X ORSC I $T,$D(@(ORUS_"B,0)")) X ORWR I $L(X) S S=S+1,^XUTL("OR",$J,"ORW",S)=B
I OREN S O=OROD,(B,S)=0 F I=0:0 S B=$O(@(O_"B)")) Q:B="" I $D(@(ORUS_"B,0)")) S ORDA=B X ORSC I $T,$D(@(ORUS_"B,0)")) X ORWR I $L(X) S S=S+1,^XUTL("OR",$J,"ORW",S)=B
Q
SORB1 F I=0:0 S I=$O(ORUS(900,I)) Q:I'>0 D S9
I ORUS(0)["Q" S I=998,OR9(I)="OTHER "_ORFNM_"^998" D S91
Q
SPACE(NUMSP) ; added by CLA 9/18/00 for OR*3*91 - return NUMSP blank spaces
Q:+$G(NUMSP)<1 ""
N SPACES
S SPACES=""
S $P(SPACES," ",NUMSP)=" "
Q SPACES
EN1 ;Display but not prompt (accept RETURN only)
Q:'$D(ORUS)!('$D(ORUS(0))) S ORUS("A")="Press RETURN to continue ",ORUS(0)=ORUS(0)_"M",ORNOSEL=1,ORUS("H")="W !,""Press RETURN key to continue.""" G EN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUS 2368 printed Dec 13, 2024@02:34:31 Page 2
ORUS ; slc/KCM - Display List of Items ; 12/4/09 5:03pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**91,322**;Dec 17, 1997;Build 15
+2 ;
EN SET Y=-1
if '$DATA(ORUS)!('$DATA(ORUS(0)))
QUIT
if '($DATA(IO)#2)
SET IO="HOME"
IF 'IO
SET IOP=$SELECT($DATA(ORIO):ORIO,1:"")
DO ^%ZIS
+1 DO INIT^ORUS5
+2 IF ORUS(0)["M"
FOR I=0:0
DO HDR
DO MOVE^ORUS5
DO SHOW
DO EN^ORUS1
IF 'ORBACK
if 'ORMOR
QUIT
if ORQUIT
QUIT
+3 IF ORUS(0)'["M"
if ORUS(0)["N"
DO SORB
DO SORB1
DO EN^ORUS1
END KILL %,A,B,J,K,L,M,N,O,OR9,OR9Y,ORBACK,ORBUF,ORCO,ORCW,ORDA,ORDFLT,OREN,ORENL,ORENLA,ORERR,ORFLG,ORFN,ORFND,ORFNM,ORHL,ORITM,ORLK,ORMOR,ORNC,ORND,ORNE,ORNOSEL,OROD,ORPC,ORPRMT,ORPTR,ORQUIT,ORSC
+1 KILL ORUS,ORSEL,ORSEQ,ORSEQL,ORSUB,ORT9,ORTTAB,ORTB,ORTOT,ORWR,ORWRK,P,S,W,X,^XUTL("OR",$JOB,"ORU"),^("ORV"),^("ORW")
+2 QUIT
SHOW ;changed 9/18/00 by CLA for OR*3*91:
SET L=0
+1 NEW ORTXT
+2 FOR
SET L=$ORDER(^XUTL("OR",$JOB,"ORV",P,L))
if L>ORCO!(L="")
QUIT
Begin DoDot:1
+3 WRITE !
FOR J=0:1:ORNC-1
SET X=L+(J*ORCO)
IF $DATA(^XUTL("OR",$JOB,"ORV",P,X))
Begin DoDot:2
+4 WRITE ?(J*ORTB),$PIECE(^XUTL("OR",$JOB,"ORV",P,X),"^",2),?(J*ORTB+5)
+5 SET ORTXT=$EXTRACT($PIECE(^XUTL("OR",$JOB,"ORV",P,X),"^"),1,ORTB-5)
+6 FOR
if '(ORTXT["|SP")
QUIT
SET ORTXT=$PIECE(ORTXT,"|",1)_$$SPACE(+$PIECE($PIECE(ORTXT,"|",2),"SP",2))_$PIECE(ORTXT,"|",3,999)
+7 WRITE ORTXT
+8 ;DJE/VM *322 replace 999 with +
IF ^(X)="MORE...^+"
IF '$DATA(OR9("+"))
SET I="+"
SET OR9(I)=^(X)
DO S91
End DoDot:2
End DoDot:1
+9 QUIT
HDR SET (DX,DY)=0
XECUTE ^%ZOSF("XY")
if $DATA(ORUS("T"))
XECUTE ORUS("T")
SET ORHL=$Y
KILL DX,DY
QUIT
S9 SET OR9(I)=ORUS(900,I)
if '$LENGTH($PIECE(OR9(I),"^",2))
SET $PIECE(OR9(I),"^",2)=900+I
S91 if $LENGTH($PIECE(OR9(I),"^",1))
SET OR9("B",$PIECE(OR9(I),"^",1),I)=""
if $LENGTH($PIECE(OR9(I),"^",2))
SET OR9("B",$PIECE(OR9(I),"^",2),I)=""
+1 QUIT
SORB IF 'OREN
SET O=OROD
SET A=""
SET S=0
FOR I=0:0
SET A=$ORDER(@(O_"A)"))
if A=""
QUIT
SET B=""
FOR
SET B=$ORDER(@(O_"A,B)"))
if B=""
QUIT
IF $DATA(@(ORUS_"B,0)"))
SET ORDA=B
XECUTE ORSC
IF $TEST
IF $DATA(@(ORUS_"B,0)"))
XECUTE ORWR
IF $LENGTH(X)
SET S=S+1
SET ^XUTL("OR",$JOB,"ORW",S)=B
+1 IF OREN
SET O=OROD
SET (B,S)=0
FOR I=0:0
SET B=$ORDER(@(O_"B)"))
if B=""
QUIT
IF $DATA(@(ORUS_"B,0)"))
SET ORDA=B
XECUTE ORSC
IF $TEST
IF $DATA(@(ORUS_"B,0)"))
XECUTE ORWR
IF $LENGTH(X)
SET S=S+1
SET ^XUTL("OR",$JOB,"ORW",S)=B
+2 QUIT
SORB1 FOR I=0:0
SET I=$ORDER(ORUS(900,I))
if I'>0
QUIT
DO S9
+1 IF ORUS(0)["Q"
SET I=998
SET OR9(I)="OTHER "_ORFNM_"^998"
DO S91
+2 QUIT
SPACE(NUMSP) ; added by CLA 9/18/00 for OR*3*91 - return NUMSP blank spaces
+1 if +$GET(NUMSP)<1
QUIT ""
+2 NEW SPACES
+3 SET SPACES=""
+4 SET $PIECE(SPACES," ",NUMSP)=" "
+5 QUIT SPACES
EN1 ;Display but not prompt (accept RETURN only)
+1 if '$DATA(ORUS)!('$DATA(ORUS(0)))
QUIT
SET ORUS("A")="Press RETURN to continue "
SET ORUS(0)=ORUS(0)_"M"
SET ORNOSEL=1
SET ORUS("H")="W !,""Press RETURN key to continue."""
GOTO EN
