| [613] | 1 | XQORM3 ; SLC/KCM - Lookup (cont.) ;11/12/92 11:28
|
|---|
| 2 | ;;8.0;KERNEL;**56,62**;Jul 10, 1995
|
|---|
| 3 | LOOK ;From: XQORM2
|
|---|
| 4 | K ORUFD,ORUDA S ORUFD=0,ORUW=X
|
|---|
| 5 | I $D(^XUTL("XQORM",XQORM,"B",X)) S ORUDA=0 F I=0:0 S ORUDA=$O(^XUTL("XQORM",XQORM,"B",X,ORUDA)) Q:ORUDA="" I '$D(ORUDA(ORUDA)) D LOOK1 Q:ORUER
|
|---|
| 6 | S:$E(X,$L(X),1)'=" " X=$E(X,1,$L(X)-1)_$C($A($E(X,$L(X)))-1)_"~"
|
|---|
| 7 | F I=0:0 S X=$O(^XUTL("XQORM",XQORM,"B",X)) Q:X=""!($E(X,1,$L(ORUW))'=ORUW)!(XQORM(0)["X"&(X'=ORUW)) S ORUDA=0 F I=0:0 S ORUDA=$O(^XUTL("XQORM",XQORM,"B",X,ORUDA)) Q:ORUDA="" I '$D(ORUDA(ORUDA)) D LOOK1
|
|---|
| 8 | S ORUDA=0 Q:ORUER I ORUFD=1 S ORUDA=ORUFD(1) Q
|
|---|
| 9 | I 'ORUFD,$D(XQORM("#")),ORUW?1.12N D Q:ORUDA
|
|---|
| 10 | . N X S X=$P(XQORM("#"),"^",2)
|
|---|
| 11 | . I X[":" Q:(ORUW<X)!(ORUW>$P(X,":",2))
|
|---|
| 12 | . I $L(X),X'[":" Q:(","_X_",")'[(","_ORUW_",")
|
|---|
| 13 | . S ORUDA=ORUW
|
|---|
| 14 | I 'ORUFD,$L($P(ORUW," ")),(($D(XQORM("KEY",$P(ORUW," ")))&('$D(XQORM("NO^^"))))!(ORUW="ALL")) S ORUDA=ORUW,ORUDA("KEY")="" Q
|
|---|
| 15 | I 'ORUFD,$D(XQORM("ALT")) S ORUER=1 Q
|
|---|
| 16 | I 'ORUFD,XQORM(0)["A" S ORUER=1 D NF^XQORM4 I (ORUX[",")!(ORUX["-") S ORUER=0 D PICK
|
|---|
| 17 | D:ORUFD>1 PICK ;S:'ORUFD ORUER=1
|
|---|
| 18 | Q
|
|---|
| 19 | LOOK1 S ORUFD=ORUFD+1,ORUFD(ORUFD)=ORUDA,ORUDA(ORUDA)=""
|
|---|
| 20 | Q
|
|---|
| 21 | PICK I (XQORM(0)'["A")&(XQORM(0)'["E") S ORUFD=0 Q
|
|---|
| 22 | I ORUFD F J=1:1:ORUFD W:$D(^XUTL("XQORM",XQORM,ORUFD(J),0)) !,$J(J,6),?9,$P(^(0),"^",3)
|
|---|
| 23 | F I=0:0 D PICK1 I $L(X)'>80,X?.ANP S:'$T X="^" Q:X'["?" D HELP3^XQORM5
|
|---|
| 24 | I X="" D
|
|---|
| 25 | . N J,C S (J,C)=0 F S J=$O(ORUX(J)) Q:'J S C=C+1
|
|---|
| 26 | . I C=1 S X="^" W ! ; reprompt if 1 selection
|
|---|
| 27 | S:X="^" ORUER=1 S:X="^^" (ORUER,DIROUT)=1 S ORUFD=0 Q:ORUER
|
|---|
| 28 | I $L(X),$D(ORUFD(X)) S ORUDA=ORUFD(X),ORUFD=1 Q
|
|---|
| 29 | D:$L(X)&(X'["^") LOOK
|
|---|
| 30 | Q
|
|---|
| 31 | PICK1 W !,$S(ORUX[","!(ORUX["-"):"For entry """_ORUW_""" ",1:""),$S(ORUFD:"CHOOSE 1-"_ORUFD_": ",1:"re-enter: ")
|
|---|
| 32 | R X:$S($D(DTIME):DTIME,1:"") D:X'?.ANP CC^XQORM4 D:$L(X)>80 LL^XQORM4 D UP^XQORM1
|
|---|
| 33 | Q
|
|---|
| 34 | UPD ;from XQORM2
|
|---|
| 35 | S X="",ORUSQ=ORUSQ+1 S:$D(^XUTL("XQORM",XQORM,ORUDA,0)) X=^(0) I '$L(X) S ORUER=1 Q
|
|---|
| 36 | I $D(ORUX(ORUT,"'")) S X=$O(Y("B",ORUDA,"")) K:$L(X) Y(X),Y("B",ORUDA,X) S:$L(X) Y=Y-1 Q
|
|---|
| 37 | S Y=Y+1,Y(ORUSQ)=$P(X,"^",1,3),Y("B",ORUDA,ORUSQ)="",$P(Y(ORUSQ),"^",4)=ORUX(ORUT) S:$D(ORUX(ORUT,"=")) Y(ORUSQ)=Y(ORUSQ)_"="_ORUX(ORUT,"=")
|
|---|
| 38 | Q
|
|---|
| 39 | RNG ;From: XQORM2
|
|---|
| 40 | N K Q:X'?1.12N1"-"1.12N
|
|---|
| 41 | I $P(X,"-",1)'<$P(X,"-",2) D:XQORM(0)["A" IR^XQORM4 S ORUER=1 Q
|
|---|
| 42 | S ORUB="" F K=$P(X,"-",1):1:$P(X,"-",2) S ORUB=ORUB_K_"," I $L(ORUB)>225 D:XQORM(0)["A" LR^XQORM4 S ORUER=1 Q
|
|---|
| 43 | S X=ORUB
|
|---|
| 44 | Q
|
|---|
