- ORUS5 ; slc/KCM - Display List of Items ;1/3/91 10:01 ;
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- ;
- 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...^999",I=999,OR9(I)=^(L) D S91
- 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
- ORUS5 ; slc/KCM - Display List of Items ;1/3/91 10:01 ;
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- +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 IF ORMOR
- SET L=L+1
- SET ^XUTL("OR",$JOB,"ORV",P,L)="MORE...^999"
- SET I=999
- 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
