source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRPXAPI6.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.0 KB
RevLine 
[613]1LRPXAPI6 ;SLC/STAFF Lab Extract API code ;10/5/03 14:53
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4CONDS(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 ;
32XCONDS(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 ;
69ITEM(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 ;
89CHECK(VAR,COND,VALUE) ; $$(variable,condition,value) -> 1 or 0
90 S @VAR=VALUE
91 X COND
92 Q $T
93 ;
94TEST ; *** used for testing only
95 F D T
96 Q
97T 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
Note: See TracBrowser for help on using the repository browser.