| [613] | 1 | LRSORA1 ;SLC/KCM - CREATE SEARCH LOGIC ; 8/5/87 11:40 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | EN W ! F J=1:1:LRTST W !,"-",$C(64+J),"-"," ",$P(LRTST(J,2),U,1) W:$P(LRTST(J,2),U,2)]"" " (",$P(LRTST(J,2),U,2),")" W " ",$P(LRTST(J,2),U,3)
|
|---|
| 4 | S LRA="A" F I=1:1:LRTST-1 S LRA=LRA_" OR "_$C(65+I)
|
|---|
| 5 | S Y=-1 F I=0:0 W !!,"Enter SEARCH LOGIC: ",LRA,"// " R X:DTIME S:'$T X="^" S:X["^" LREND=1 D:X["?" HLP0 S:'$L(X) X=LRA D:(X'["?")&(X'["^") PLOG Q:Y'<0!LREND
|
|---|
| 6 | S LRTST(0)=Y Q
|
|---|
| 7 | PLOG F %=1:1 S T=$T(SWAP+%) Q:$P(T,";",3)="ZZZZ" S LROLD=$P(T,";",3),LRNEW=$P(T,";",4) D PARSE
|
|---|
| 8 | S Y="" F %=1:1:$L(X) S:$E(X,%)'=" " Y=Y_$E(X,%)
|
|---|
| 9 | F %=1:1:$L(Y) S T=$A(Y,%) S LROK=0 D TSTLIM I 'LROK S Y=-1 Q
|
|---|
| 10 | I Y'=-1 S X="I "_Y D ^DIM S:'$D(X) Y=-1
|
|---|
| 11 | STOP W:Y<0 " ??" K LRPNT,LROLD,LRNEW,LROK,LRI,LRJ,X,T,% Q
|
|---|
| 12 | TSTLIM F LRJ=33,38,39,40,41,65:1:64+LRTST S:T=LRJ LROK=1
|
|---|
| 13 | Q
|
|---|
| 14 | PARSE F LRI=1:1:$L(LROLD)-$L(LRNEW) S LRNEW=LRNEW_" "
|
|---|
| 15 | S LRPNT(0)=0 F LRI=1:1 S LRPNT(LRI)=$F(X,LROLD,LRPNT(LRI-1)) Q:LRPNT(LRI)=0
|
|---|
| 16 | F LRJ=1:1:LRI-1 S X=$E(X,1,LRPNT(LRJ)-$L(LROLD)-1)_LRNEW_$E(X,LRPNT(LRJ),99)
|
|---|
| 17 | Q
|
|---|
| 18 | SWAP ;;LROLD;LRNEW; NOTE: $L(LROLD) MUST BE >= $L(LRNEW)
|
|---|
| 19 | ;;AND;&
|
|---|
| 20 | ;;OR;!
|
|---|
| 21 | ;;NOT;'
|
|---|
| 22 | ;;,;&
|
|---|
| 23 | ;;ZZZZ
|
|---|
| 24 | HLP0 W !!,"Enter a logical expression (i.e., A AND B OR C or A&B!C)."
|
|---|
| 25 | W !," NOTE: AND will compare only values from the -same- accession."
|
|---|
| 26 | W !," To print all results that fall within the search criteria,"
|
|---|
| 27 | W !," accept the default search logic (OR)."
|
|---|
| 28 | SUMMARY ;
|
|---|
| 29 | Q
|
|---|
| 30 | SORTBY ;
|
|---|
| 31 | K DIR S DIR("B")="P",DIR("A")="Sort by PATIENT or by LOCATION"
|
|---|
| 32 | S DIR(0)="S^P:PATIENT;L:LOCATION",DIR("?")="Choose print sorting order."
|
|---|
| 33 | D ^DIR S:($D(DUOUT))!($D(DTOUT)) LREND=1 S:'LREND LRSRT=Y Q
|
|---|
| 34 | PATS ;
|
|---|
| 35 | S LRPTS=0
|
|---|
| 36 | K DIC S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select PATIENT NAME: All//"
|
|---|
| 37 | F I=1:1 D ^DIC Q:Y=-1 S LRPTS(+Y)=$P(Y,U,2),DIC("A")="Select another PATIENT: ",LRPTS=I
|
|---|
| 38 | S:($D(DUOUT))!($D(DTOUT)) LREND=1 Q
|
|---|
| 39 | LOCS ;
|
|---|
| 40 | S LRLCS=0
|
|---|
| 41 | K DIC S DIC="^SC(",DIC(0)="AEMQZ",DIC("A")="Select LOCATION: All//"
|
|---|
| 42 | F I=1:1 D ^DIC Q:Y=-1 D
|
|---|
| 43 | .S DIC("A")="Select another LOCATION: "
|
|---|
| 44 | .I $P(Y(0),U,2)="" D NOABRV Q:%'=1
|
|---|
| 45 | .S LRLCS($S($L($P(Y(0),U,2)):$P(Y(0),U,2),1:"NO ABRV"))=+Y,LRLCS=I
|
|---|
| 46 | S:($D(DUOUT))!($D(DTOUT)) LREND=1 K %,%Y Q
|
|---|
| 47 | NOABRV ;
|
|---|
| 48 | W !!,"The location you have selected does not have an abbreviation."
|
|---|
| 49 | W !,"If you use this location, the report will list all records without"
|
|---|
| 50 | W " location",!,"abbreviations (as long as they also meet the date and"
|
|---|
| 51 | W " patient selections)",!,"This may include data from several "
|
|---|
| 52 | W "locations, with no way to be sure which is",!,"which. They will be "
|
|---|
| 53 | W "listed with the abbreviation of 'NO ABRV' or 'UNK'."
|
|---|
| 54 | S %=1 W !!,"Do you still want to select this location (Y/N)?//"
|
|---|
| 55 | D YN^DICN
|
|---|
| 56 | Q
|
|---|
