- ORUS ; slc/KCM - Display List of Items ;6/2/92 08:09
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**91**;Dec 17, 1997
- ;
- 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...^999",'$D(OR9(999)) S I=999,OR9(I)=^(X) D S91
- 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
- ORUS ; slc/KCM - Display List of Items ;6/2/92 08:09
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**91**;Dec 17, 1997
- +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 IF ^(X)="MORE...^999"
- IF '$DATA(OR9(999))
- SET I=999
- 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
