| 1 | ORUTL ; slc/dcm,RWF - Order utilities; ;4/24/01 17:14
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**95**Dec 17, 1997
|
|---|
| 3 | LOC ;;GET PT. LOCATION
|
|---|
| 4 | S C(1)=$S($D(ORL(2))#2:$S(ORL(2)[";":$S($D(@("^"_$P(ORL(2),";",2)_+ORL(2)_",0)")):$P(^(0),"^"),1:""),1:""),1:"")
|
|---|
| 5 | I 'OR4,ORVP[";DPT(",$D(ORL(2)),ORL(2) Q
|
|---|
| 6 | G:$L(C(1)) LOC1 S (CT,C)=0,O=1 I ORVP[";DPT(",$O(^DPT(+ORVP,"DE",0))>0 W !!,"Currently enrolled in the following clinics: ",!
|
|---|
| 7 | I S I=0 F L=0:0 S I=$O(^DPT(+ORVP,"DE",I)) Q:I'>0 I $D(^(I,0)) S Y=^(0) I $P(Y,"^",2)'="I",'$P(Y,"^",3) I $D(^SC(+Y,0)) S X=^(0) D
|
|---|
| 8 | . I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),"^",2) I $S('ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) Q
|
|---|
| 9 | . S CT=CT+1 W:(CT#2) !?17 W:'(CT#2) ?47 W $P(X,"^") S C=C+1,C(1)=$P(X,"^") S:C'=1 C=-1
|
|---|
| 10 | W !
|
|---|
| 11 | LOC1 S C=1 W !,"Patient Location: " W:C=1&($L(C(1))) C(1),"//" R X:DTIME G QUIT:'$T,QUIT:C'=1&(X=""),LOC:$L(X)>20!(X'?.ANP),QUIT:X[U
|
|---|
| 12 | S DIC("S")="I ""FI""'[$P(^(0),""^"",3),'$P($G(^(""OOS"")),""^"")",DIC=44,DIC(0)=$S(C=1&($L(C(1)))&(X=""):"EMQOZX",1:"EMQZ")
|
|---|
| 13 | S:X="" X=C(1) D ^DIC G LOC:X["?" S:Y>0 ORL=+Y_";SC(",ORL(0)=$S($L($P(Y(0),"^",2)):$P(Y(0),"^",2),1:$E($P(Y(0),"^"),1,4))
|
|---|
| 14 | K ORIA,ORRA I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),U,2)
|
|---|
| 15 | I $S('$D(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) W $C(7)," This location has been inactivated." K ORL G LOC
|
|---|
| 16 | I Y<0 W " You must select a standard location." G LOC
|
|---|
| 17 | K DIC,C,ORIA,ORRA Q
|
|---|
| 18 | QUIT S OREND=1 K DIC,C Q
|
|---|
| 19 | READ ;;Hold screen
|
|---|
| 20 | I $D(IOST) Q:$E(IOST)'="C"
|
|---|
| 21 | W ! I $D(IOSL),$Y<(IOSL-4) G READ
|
|---|
| 22 | W !?5,"Press return to continue " R X:$S($D(DTIME):DTIME,1:300)
|
|---|
| 23 | Q
|
|---|
| 24 | CHKNAM(X,Y) ;Input transform to not allow certain characters
|
|---|
| 25 | ;X is the text to be checked, Y are the characters not allowed as sent in by the input transform of the field
|
|---|
| 26 | N I,J I '$D(Y) S Y="-;,=^" ;if no special characters sent in, set list to all
|
|---|
| 27 | F I=1:1:$L(Y) I X[($E(Y,I)) S J=1
|
|---|
| 28 | Q +$G(J)
|
|---|
| 29 | CHKMNE(X) ;Input transform to not allow use of standard Lmgr Mnemonics
|
|---|
| 30 | N Y
|
|---|
| 31 | S Y=$$UP^XLFSTR(X) ;check to make sure mnemonic isn't set to lower case of restricted entries. List Manager is case insensitive
|
|---|
| 32 | I Y="ADPL"!(Y="DN")!(Y="Q")!(Y="FS")!(Y="GO")!(Y="?")!(Y="??")!(Y="LS")!(Y="+")!(Y="-")!(Y="PL")!(Y="PS")!(Y="RD")!(Y="SL")!(Y="<")!(Y=">")!(Y="UP")!(Y="PI")!(Y="CWAD")!(Y="TD")!(Y="EX") Q 1
|
|---|
| 33 | Q 0
|
|---|
