| 1 | LRPXAPI6 ;SLC/STAFF Lab Extract API code ;10/5/03  14:53 | 
|---|
| 2 | ;;5.2;LAB SERVICE;**295**;Sep 27, 1994 | 
|---|
| 3 | ; | 
|---|
| 4 | CONDS(CONDS,COND,TYPE,ITEM) ; from LRPXAPI3 | 
|---|
| 5 | ; returns array CONDS of conditions - for Micro and AP | 
|---|
| 6 | ; used to determine match, XCONDS determines exact match | 
|---|
| 7 | I COND["|" D XCONDS(.CONDS,COND,TYPE,$G(ITEM)) Q | 
|---|
| 8 | N EQUAL,ITEMCHAR,NOTEQUAL,NUM,PIECE | 
|---|
| 9 | K CONDS | 
|---|
| 10 | I $E(COND)="~" S COND=$E(COND,2,245) | 
|---|
| 11 | S ITEM=$G(ITEM) | 
|---|
| 12 | I $L(ITEM) S COND=COND_"~"_$P(ITEM,";",2)_"="_$P(ITEM,";",3) | 
|---|
| 13 | S NUM=1 | 
|---|
| 14 | F  S PIECE=$P(COND,"~",NUM) Q:PIECE=""  D | 
|---|
| 15 | . S NUM=NUM+1 | 
|---|
| 16 | . S ITEMCHAR=$E(PIECE) | 
|---|
| 17 | . I ITEMCHAR="S",TYPE="A" D  Q | 
|---|
| 18 | .. S CONDS("AS",PIECE)="" | 
|---|
| 19 | . I ITEMCHAR="I",TYPE="M" D  Q | 
|---|
| 20 | .. S CONDS("MIR",PIECE)="" | 
|---|
| 21 | . I ITEMCHAR="R",TYPE="M" D  Q | 
|---|
| 22 | .. S CONDS("MIR",PIECE)="" | 
|---|
| 23 | . I ITEMCHAR="C" D  Q | 
|---|
| 24 | .. S CONDS(TYPE_"C",PIECE)="" | 
|---|
| 25 | . S NOTEQUAL=+$P(PIECE,"'=",2) | 
|---|
| 26 | . I NOTEQUAL S CONDS(0,TYPE_";"_ITEMCHAR_";"_NOTEQUAL)="" Q | 
|---|
| 27 | . S EQUAL=+$P(PIECE,"=",2) | 
|---|
| 28 | . I EQUAL S CONDS(1,TYPE_";"_ITEMCHAR_";"_EQUAL)="" Q | 
|---|
| 29 | S CONDS="~" | 
|---|
| 30 | Q | 
|---|
| 31 | ; | 
|---|
| 32 | XCONDS(CONDS,COND,TYPE,ITEM) ; | 
|---|
| 33 | ; returns array CONDS of conditions - for Micro and AP | 
|---|
| 34 | ; used to determine exact match | 
|---|
| 35 | N EQUAL,ITEMCHAR,NOTEQUAL,NUM,PIECE | 
|---|
| 36 | K CONDS | 
|---|
| 37 | I $E(COND)="|" S COND=$E(COND,2,245) | 
|---|
| 38 | S ITEM=$G(ITEM) | 
|---|
| 39 | I $L(ITEM) S COND=COND_"|"_$P(ITEM,";",2)_"="_$P(ITEM,";",3) | 
|---|
| 40 | S NUM=1 | 
|---|
| 41 | F  S PIECE=$P(COND,"|",NUM) Q:PIECE=""  D | 
|---|
| 42 | . S NUM=NUM+1 | 
|---|
| 43 | . S ITEMCHAR=$E(PIECE) | 
|---|
| 44 | . I ITEMCHAR="S",TYPE="A" D  Q | 
|---|
| 45 | .. S CONDS("AS",PIECE)="" | 
|---|
| 46 | .. S CONDS("X","A;S")="" | 
|---|
| 47 | . I ITEMCHAR="I",TYPE="M" D  Q | 
|---|
| 48 | .. S CONDS("MIR",PIECE)="" | 
|---|
| 49 | .. S CONDS("X","MIR","I")="" | 
|---|
| 50 | . I ITEMCHAR="R",TYPE="M" D  Q | 
|---|
| 51 | .. S CONDS("MIR",PIECE)="" | 
|---|
| 52 | .. S CONDS("X","MIR","R")="" | 
|---|
| 53 | . I ITEMCHAR="C" D  Q | 
|---|
| 54 | .. S CONDS(TYPE_"C",PIECE)="" | 
|---|
| 55 | .. S CONDS("X",TYPE_";C")="" | 
|---|
| 56 | . S NOTEQUAL=+$P(PIECE,"'=",2) | 
|---|
| 57 | . I NOTEQUAL D  Q | 
|---|
| 58 | .. S CONDS(0,TYPE_";"_ITEMCHAR_";"_NOTEQUAL)="" | 
|---|
| 59 | .. S CONDS("X",TYPE_";"_ITEMCHAR)="" | 
|---|
| 60 | . S EQUAL=+$P(PIECE,"=",2) | 
|---|
| 61 | . I EQUAL D  Q | 
|---|
| 62 | .. S CONDS(1,TYPE_";"_ITEMCHAR_";"_EQUAL)="" | 
|---|
| 63 | .. S CONDS("X",TYPE_";"_ITEMCHAR)="" | 
|---|
| 64 | . S CONDS("X",TYPE)="" | 
|---|
| 65 | S CONDS="|" | 
|---|
| 66 | I NUM=2 S CONDS="~" | 
|---|
| 67 | Q | 
|---|
| 68 | ; | 
|---|
| 69 | ITEM(ITEM,TYPE,COND,ERR) ; from LRPXAPI1 | 
|---|
| 70 | ; return an item from condition | 
|---|
| 71 | N DEL,ITEMCHAR,NUM,PIECE | 
|---|
| 72 | S ERR=1,ITEM="" | 
|---|
| 73 | I TYPE="C" Q | 
|---|
| 74 | I COND["|" S DEL="|" | 
|---|
| 75 | E  S DEL="~" | 
|---|
| 76 | S NUM=1 | 
|---|
| 77 | F  S PIECE=$P(COND,DEL,NUM) Q:PIECE=""  D  Q:$L(ITEM) | 
|---|
| 78 | . S NUM=NUM+1 | 
|---|
| 79 | . S ITEMCHAR=$E(PIECE) | 
|---|
| 80 | . I $E(PIECE,2)'="=" Q | 
|---|
| 81 | . I ITEMCHAR="C" Q | 
|---|
| 82 | . I ITEMCHAR="R" Q | 
|---|
| 83 | . I ITEMCHAR="I",TYPE="M" Q | 
|---|
| 84 | . I ITEMCHAR="S",TYPE="A" S ITEM="A;S;1."_$P(PIECE,"=",2) Q | 
|---|
| 85 | . S ITEM=TYPE_";"_ITEMCHAR_";"_$P(PIECE,"=",2) Q | 
|---|
| 86 | I $L(ITEM) S ERR=0 | 
|---|
| 87 | Q | 
|---|
| 88 | ; | 
|---|
| 89 | CHECK(VAR,COND,VALUE) ; $$(variable,condition,value) -> 1 or 0 | 
|---|
| 90 | S @VAR=VALUE | 
|---|
| 91 | X COND | 
|---|
| 92 | Q $T | 
|---|
| 93 | ; | 
|---|
| 94 | TEST ; *** used for testing only | 
|---|
| 95 | F  D T | 
|---|
| 96 | Q | 
|---|
| 97 | T N TYPE,ERR,COND,CONDS K CONDS | 
|---|
| 98 | ;D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q | 
|---|
| 99 | D GETCOND^LRPXAPPU(.COND,"A",.ERR) I ERR Q | 
|---|
| 100 | D CONDS(.CONDS,COND,"A") | 
|---|
| 101 | ;W ! ZW CONDS | 
|---|
| 102 | ;I $$MATCH^LRPXAPI5(2,2950206.1116,.CONDS) W !,"YES",! Q | 
|---|
| 103 | ;I $$MATCH^LRPXAPI5(14,2980910.100232,.CONDS) W !,"YES",! Q | 
|---|
| 104 | I $$MATCH^LRPXAPI5(16,2960503,.CONDS) W !,"YES",! Q | 
|---|
| 105 | W !,"NO",! | 
|---|
| 106 | Q | 
|---|