ORUS5 ; slc/KCM - Display List of Items ;1/3/91 10:01 ; 12/4/09 5:15pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**322**;Dec 17, 1997;Build 15
;
MOVE K OR9 I $D(^XUTL("OR",$J,"ORV",P,0)),$D(^(0)) S X=^(0),ORCO=$S($P(X,"^"):$P(X,"^"),1:+$G(ORCO)),ORSEQL=$S($P(X,"^",4):$P(X,"^",4),1:""),ORENL=$P(X,"^",2),ORENLA=$P(X,"^",3) Q
;I ORMOR,$D(^XUTL("OR",$J,"ORV",P,0)),$D(^(0)) S ORCO=$S(^(0):^(0),1:ORCO) Q
S OR9=0 I $D(ORUS("900")) F I=0:0 S I=$O(ORUS("900",I)) Q:I="" S OR9=OR9+1
S ORCO=IOSL-ORHL-3,ORNE=(ORCO*ORNC)-OR9-2
S A="",(B,L,S)=0,O=$S(OREN:ORUS,1:OROD),C=ORUS,N=(ORUS(0)["N"),M=$D(ORUS("M")) S:ORMOR S=$S($D(ORSEQL):ORSEQL,1:ORCO),B=ORENL,A=$S($D(ORENLA):$S($L(ORENLA):$E(ORENLA,1,($L(ORENLA)-1))_$C($A($E(ORENLA,$L(ORENLA)))-1),1:""),1:"")
I 'OREN F Q:L'<ORNE S A=$O(@(O_"A)")) Q:A="" F Q:L'<ORNE S B=$O(@(O_"A,B)")) Q:B="" I ^(B)'=1,$D(@(C_"B,0)")) D M1
I OREN F Q:L'<ORNE S B=$O(@(O_"B)")) Q:B="" I $D(@(O_"B,0)")) S ORDA=B X ORSC I $T,$D(@(O_"B,0)")) S L=L+1 X ORWR I $L(X) S ^XUTL("OR",$J,"ORV",P,L)=X S:N S=S+1,$P(^(L),"^",2)=S,^XUTL("OR",$J,"ORW",S)=B D:M MNE
S ORMOR=0 S:($L(A)&('OREN))!($L(B)&OREN) ORMOR=1,ORENL=B,ORENLA=$S(OREN:"",1:A),ORSEQL=S
F I=0:0 S I=$O(ORUS(900,I)) Q:I'>0 S L=L+1,^XUTL("OR",$J,"ORV",P,L)=ORUS(900,I) S:'$L($P(ORUS(900,I),"^",2)) $P(^(L),"^",2)=900+I I '$D(OR9(I)) S OR9(I)=^(L) D S91
I ORUS(0)["Q" S L=L+1,^XUTL("OR",$J,"ORV",P,L)=$S($D(ORUS("O")):ORUS("O"),1:"OTHER "_ORFNM)_"^998",I=998,OR9(I)=^(L) D S91
I ORMOR S L=L+1,^XUTL("OR",$J,"ORV",P,L)="MORE...^+",I="+",OR9(I)=^(L) D S91 ;DJE/VM *322 replace 999 with +
I L'>ORNE S ORCO=L\ORNC S:L#ORNC ORCO=ORCO+1
S ^XUTL("OR",$J,"ORV",P,0)=ORCO_"^"_$S($D(ORENL):ORENL,1:"")_"^"_$S($D(ORENLA):ORENLA,1:"")_"^"_$S($D(ORSEQL):ORSEQL,1:"")
Q
INIT K OROTHER ;^XUTL("OR",$J,"ORV"),^("ORW")
S (ORBACK,ORFN,ORMOR,ORQUIT,P)=0,ORFNM="" I +ORUS S:$D(^DIC(+ORUS,0,"GL")) ORUS=^("GL")
I $D(@(ORUS_"0)")) S ORFNM=$P(^(0),"^"),ORFN=+$P(^(0),"^",2)
S ORPTR=0 I ORFN S X=$P(^DD(+ORFN,.01,0),"^",2) S:'$L(ORFNM) ORFNM=$P(^(0),"^") I X["V"!(X["P"),'$D(ORUS("W")) S ORPTR=1
S:'$L(ORFNM) ORFNM="ITEM(s)"
S ORCW=80 S:ORUS(0) ORCW=+ORUS(0) S ORNC=IOM\$S(IOM>79:ORCW,1:IOM),ORTB=IOM\ORNC
S ORSC="I 1" S:$D(ORUS("S")) ORSC=ORUS("S")
S ORWR="S X=$P(^(0),""^"")" S:$D(ORUS("W")) ORWR=ORUS("W")
I ORPTR S ORWR="N Y S Y=$P(^(0),""^""),C=$P(^DD(ORFN,.01,0),""^"",2) D Y^DIQ S X=Y Q"
I '$D(ORUS("L"))!('$D(ORUS("F"))&(ORUS(0)["A")) D EN^ORUS2
S (OROD,ORLK)="^XUTL(""OR"",$J,""ORU""," S:ORUS(0)'["A" OROD=ORUS
S OREN=0 I '$D(ORUS("F")),ORUS(0)'["A" S OREN=1
S:$D(ORUS("F")) OROD=ORUS("F") S:$D(ORUS("L")) ORLK=ORUS("L")
Q
M1 S ORDA=B X ORSC
I $T,$D(@(C_"B,0)")) S L=L+1 X ORWR I $L(X) S ^XUTL("OR",$J,"ORV",P,L)=X S:N S=S+1,$P(^(L),"^",2)=S,^XUTL("OR",$J,"ORW",S)=B D:M MNE
Q
MNE S X=ORUS("M") I X?.AN1";".N S Y=$P(X,";",2),X=$P(X,";") Q:'$D(@(ORUS_"B,X)")) S X=$P(^(X),"^",Y) S:$L(X) $P(^XUTL("OR",$J,"ORV",P,L),"^",2)=X Q
;I X'?.AN1";".N,$L(ORUS("M")) X ORUS("M") S:$L(X) $P(^XUTL("OR",$J,"ORV",P,L),"^",2)=X Q
Q
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUS5 3167 printed Dec 13, 2024@02:34:36 Page 2
ORUS5 ; slc/KCM - Display List of Items ;1/3/91 10:01 ; 12/4/09 5:15pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**322**;Dec 17, 1997;Build 15
+2 ;
MOVE KILL OR9
IF $DATA(^XUTL("OR",$JOB,"ORV",P,0))
IF $DATA(^(0))
SET X=^(0)
SET ORCO=$SELECT($PIECE(X,"^"):$PIECE(X,"^"),1:+$GET(ORCO))
SET ORSEQL=$SELECT($PIECE(X,"^",4):$PIECE(X,"^",4),1:"")
SET ORENL=$PIECE(X,"^",2)
SET ORENLA=$PIECE(X,"^",3)
QUIT
+1 ;I ORMOR,$D(^XUTL("OR",$J,"ORV",P,0)),$D(^(0)) S ORCO=$S(^(0):^(0),1:ORCO) Q
+2 SET OR9=0
IF $DATA(ORUS("900"))
FOR I=0:0
SET I=$ORDER(ORUS("900",I))
if I=""
QUIT
SET OR9=OR9+1
+3 SET ORCO=IOSL-ORHL-3
SET ORNE=(ORCO*ORNC)-OR9-2
+4 SET A=""
SET (B,L,S)=0
SET O=$SELECT(OREN:ORUS,1:OROD)
SET C=ORUS
SET N=(ORUS(0)["N")
SET M=$DATA(ORUS("M"))
if ORMOR
SET S=$SELECT($DATA(ORSEQL):ORSEQL,1:ORCO)
SET B=ORENL
SET A=$SELECT($DATA(ORENLA):$SELECT($LENGTH(ORENLA):$EXTRACT(ORENLA,1,($LENGTH(ORENLA)-1))_$CHAR($ASCII($EXTRACT(ORENLA,$LENGTH(ORENLA)))-1),1:""),1:"")
+5 IF 'OREN
FOR
if L'<ORNE
QUIT
SET A=$ORDER(@(O_"A)"))
if A=""
QUIT
FOR
if L'<ORNE
QUIT
SET B=$ORDER(@(O_"A,B)"))
if B=""
QUIT
IF ^(B)'=1
IF $DATA(@(C_"B,0)"))
DO M1
+6 IF OREN
FOR
if L'<ORNE
QUIT
SET B=$ORDER(@(O_"B)"))
if B=""
QUIT
IF $DATA(@(O_"B,0)"))
SET ORDA=B
XECUTE ORSC
IF $TEST
IF $DATA(@(O_"B,0)"))
SET L=L+1
XECUTE ORWR
IF $LENGTH(X)
SET ^XUTL("OR",$JOB,"ORV",P,L)=X
if N
SET S=S+1
SET $PIECE(^(L),"^",2)=S
SET ^XUTL("OR",$JOB,"ORW",S)=B
if M
DO MNE
+7 SET ORMOR=0
if ($LENGTH(A)&('OREN))!($LENGTH(B)&OREN)
SET ORMOR=1
SET ORENL=B
SET ORENLA=$SELECT(OREN:"",1:A)
SET ORSEQL=S
+8 FOR I=0:0
SET I=$ORDER(ORUS(900,I))
if I'>0
QUIT
SET L=L+1
SET ^XUTL("OR",$JOB,"ORV",P,L)=ORUS(900,I)
if '$LENGTH($PIECE(ORUS(900,I),"^",2))
SET $PIECE(^(L),"^",2)=900+I
IF '$DATA(OR9(I))
SET OR9(I)=^(L)
DO S91
+9 IF ORUS(0)["Q"
SET L=L+1
SET ^XUTL("OR",$JOB,"ORV",P,L)=$SELECT($DATA(ORUS("O")):ORUS("O"),1:"OTHER "_ORFNM)_"^998"
SET I=998
SET OR9(I)=^(L)
DO S91
+10 ;DJE/VM *322 replace 999 with +
IF ORMOR
SET L=L+1
SET ^XUTL("OR",$JOB,"ORV",P,L)="MORE...^+"
SET I="+"
SET OR9(I)=^(L)
DO S91
+11 IF L'>ORNE
SET ORCO=L\ORNC
if L#ORNC
SET ORCO=ORCO+1
+12 SET ^XUTL("OR",$JOB,"ORV",P,0)=ORCO_"^"_$SELECT($DATA(ORENL):ORENL,1:"")_"^"_$SELECT($DATA(ORENLA):ORENLA,1:"")_"^"_$SELECT($DATA(ORSEQL):ORSEQL,1:"")
+13 QUIT
INIT ;^XUTL("OR",$J,"ORV"),^("ORW")
KILL OROTHER
+1 SET (ORBACK,ORFN,ORMOR,ORQUIT,P)=0
SET ORFNM=""
IF +ORUS
if $DATA(^DIC(+ORUS,0,"GL"))
SET ORUS=^("GL")
+2 IF $DATA(@(ORUS_"0)"))
SET ORFNM=$PIECE(^(0),"^")
SET ORFN=+$PIECE(^(0),"^",2)
+3 SET ORPTR=0
IF ORFN
SET X=$PIECE(^DD(+ORFN,.01,0),"^",2)
if '$LENGTH(ORFNM)
SET ORFNM=$PIECE(^(0),"^")
IF X["V"!(X["P")
IF '$DATA(ORUS("W"))
SET ORPTR=1
+4 if '$LENGTH(ORFNM)
SET ORFNM="ITEM(s)"
+5 SET ORCW=80
if ORUS(0)
SET ORCW=+ORUS(0)
SET ORNC=IOM\$SELECT(IOM>79:ORCW,1:IOM)
SET ORTB=IOM\ORNC
+6 SET ORSC="I 1"
if $DATA(ORUS("S"))
SET ORSC=ORUS("S")
+7 SET ORWR="S X=$P(^(0),""^"")"
if $DATA(ORUS("W"))
SET ORWR=ORUS("W")
+8 IF ORPTR
SET ORWR="N Y S Y=$P(^(0),""^""),C=$P(^DD(ORFN,.01,0),""^"",2) D Y^DIQ S X=Y Q"
+9 IF '$DATA(ORUS("L"))!('$DATA(ORUS("F"))&(ORUS(0)["A"))
DO EN^ORUS2
+10 SET (OROD,ORLK)="^XUTL(""OR"",$J,""ORU"","
if ORUS(0)'["A"
SET OROD=ORUS
+11 SET OREN=0
IF '$DATA(ORUS("F"))
IF ORUS(0)'["A"
SET OREN=1
+12 if $DATA(ORUS("F"))
SET OROD=ORUS("F")
if $DATA(ORUS("L"))
SET ORLK=ORUS("L")
+13 QUIT
M1 SET ORDA=B
XECUTE ORSC
+1 IF $TEST
IF $DATA(@(C_"B,0)"))
SET L=L+1
XECUTE ORWR
IF $LENGTH(X)
SET ^XUTL("OR",$JOB,"ORV",P,L)=X
if N
SET S=S+1
SET $PIECE(^(L),"^",2)=S
SET ^XUTL("OR",$JOB,"ORW",S)=B
if M
DO MNE
+2 QUIT
MNE SET X=ORUS("M")
IF X?.AN1";".N
SET Y=$PIECE(X,";",2)
SET X=$PIECE(X,";")
if '$DATA(@(ORUS_"B,X)"))
QUIT
SET X=$PIECE(^(X),"^",Y)
if $LENGTH(X)
SET $PIECE(^XUTL("OR",$JOB,"ORV",P,L),"^",2)=X
QUIT
+1 ;I X'?.AN1";".N,$L(ORUS("M")) X ORUS("M") S:$L(X) $P(^XUTL("OR",$J,"ORV",P,L),"^",2)=X Q
+2 QUIT
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
