| [613] | 1 | LRPXAPI4 ;SLC/STAFF Lab Extract API code - Exact Match ;9/29/03 21:17
|
|---|
| 2 | ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | EXACT(DFN,DATE,CONDS) ; from LRPXAPI5
|
|---|
| 5 | ; check if conditions are met for date/time
|
|---|
| 6 | N FETCH,ITEM,NODE,OK,RESULTS,SEPARATE,XDATE K FETCH,RESULTS,SEPARATE
|
|---|
| 7 | S OK=1
|
|---|
| 8 | I '$L($O(CONDS(""))) Q 1
|
|---|
| 9 | M FETCH=^PXRMINDX(63,"PDI",DFN,DATE)
|
|---|
| 10 | S ITEM=""
|
|---|
| 11 | F S ITEM=$O(FETCH(ITEM)) Q:ITEM="" D
|
|---|
| 12 | . S NODE=""
|
|---|
| 13 | . F S NODE=$O(FETCH(ITEM,NODE)) Q:NODE="" D
|
|---|
| 14 | .. S SEPARATE($P(NODE,";",1,3),ITEM,NODE)=""
|
|---|
| 15 | S XDATE=""
|
|---|
| 16 | F S XDATE=$O(SEPARATE(XDATE)) Q:XDATE="" D Q:OK
|
|---|
| 17 | . K RESULTS
|
|---|
| 18 | . M RESULTS=SEPARATE(XDATE)
|
|---|
| 19 | . I '$L($O(RESULTS(""))) S OK=0 Q
|
|---|
| 20 | . I $D(CONDS("MIR")) D MIR(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 21 | . I $D(CONDS("AS")) D AS(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 22 | . I $D(CONDS("MC")) D MC(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 23 | . I $D(CONDS("AC")) D AC(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 24 | . I $D(CONDS(1)) D EQUAL(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 25 | . I $D(CONDS(0)) D NOTEQUAL(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 26 | . I '$L($O(RESULTS(""))) S OK=0 Q 0
|
|---|
| 27 | . D SCRAPS(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 28 | . D THREAD(.CONDS,.RESULTS,.OK) I 'OK Q
|
|---|
| 29 | Q OK
|
|---|
| 30 | ;
|
|---|
| 31 | THREAD(CONDS,RESULTS,OK) ;
|
|---|
| 32 | ; uses TCHK within this scope
|
|---|
| 33 | N CHK,FILE,IEN,ITEM,ITEMC,NEXT,NODE,NODEC,NUM,PAR,PARSTOP,START,STOP
|
|---|
| 34 | S OK=1
|
|---|
| 35 | ; check Micro - only O <-> A match
|
|---|
| 36 | I $D(CONDS("X","M;O")),($D(CONDS("X","M;A"))!$D(CONDS("X","M;M"))) D Q:'OK
|
|---|
| 37 | . I '($D(CONDS("X","M;A"))!$D(CONDS("X","M;M"))!$D(CONDS("X","M;MIR"))) Q
|
|---|
| 38 | . S ITEM="M;O;"
|
|---|
| 39 | . F S ITEM=$O(RESULTS(ITEM)) Q:ITEM="" Q:ITEM]"M;O;Z" D Q:'OK
|
|---|
| 40 | .. S NODE=""
|
|---|
| 41 | .. F S NODE=$O(RESULTS(ITEM,NODE)) Q:NODE="" D Q:'OK
|
|---|
| 42 | ... S IEN=$P(NODE,";",5)
|
|---|
| 43 | ... S OK=0
|
|---|
| 44 | ... S ITEMC="M;A;"
|
|---|
| 45 | ... F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"M;A;Z" D Q:OK
|
|---|
| 46 | .... S NODEC=""
|
|---|
| 47 | .... F S NODEC=$O(RESULTS(ITEMC,NODEC)) Q:NODEC="" D Q:OK
|
|---|
| 48 | ..... I IEN=$P(NODEC,";",5) S OK=1 Q
|
|---|
| 49 | ... S ITEMC="M;M;"
|
|---|
| 50 | ... F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"M;M;Z" D Q:OK
|
|---|
| 51 | .... S NODEC=""
|
|---|
| 52 | .... F S NODEC=$O(RESULTS(ITEMC,NODEC)) Q:NODEC="" D Q:OK
|
|---|
| 53 | ..... I IEN=$P(NODEC,";",5) S OK=1 Q
|
|---|
| 54 | I $D(CONDS("X","M")) Q
|
|---|
| 55 | ; check AP - M <-> E , S <-> T and O <-> [D M F P] match
|
|---|
| 56 | S PAR="A;M",START="A;E"
|
|---|
| 57 | I $D(CONDS("X",PAR)),$D(CONDS("X",START)) D TCHK(PAR,7,START) Q:'OK
|
|---|
| 58 | S PAR="A;S",START="A;T"
|
|---|
| 59 | I $D(CONDS("X",PAR)),$D(CONDS("X",START)) D TCHK(PAR,5,START) Q:'OK
|
|---|
| 60 | S PAR="A;O"
|
|---|
| 61 | I $D(CONDS("X",PAR)) D Q:'OK
|
|---|
| 62 | . F FILE="D","M","F","P" D Q:'OK
|
|---|
| 63 | .. S START="A;"_FILE
|
|---|
| 64 | .. I $D(CONDS("X",START)) D TCHK(PAR,5,START)
|
|---|
| 65 | Q
|
|---|
| 66 | TCHK(PAR,NUM,START) ; within scope of THREAD
|
|---|
| 67 | S ITEM=PAR,PARSTOP=PAR_";Z",STOP=START_";Z"
|
|---|
| 68 | F S ITEM=$O(RESULTS(ITEM)) Q:ITEM="" Q:ITEM]PARSTOP D Q:'OK
|
|---|
| 69 | . S NODE=""
|
|---|
| 70 | . F S NODE=$O(RESULTS(ITEM,NODE)) Q:NODE="" D Q:'OK
|
|---|
| 71 | .. S IEN=$P(NODE,";",1,NUM)
|
|---|
| 72 | .. S CHK=0
|
|---|
| 73 | .. S ITEMC=START
|
|---|
| 74 | .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]STOP D Q:CHK
|
|---|
| 75 | ... S NODEC=""
|
|---|
| 76 | ... F S NODEC=$O(RESULTS(ITEMC,NODEC)) Q:NODEC="" D Q:CHK
|
|---|
| 77 | .... I IEN=$P(NODEC,";",1,NUM) S CHK=1 Q
|
|---|
| 78 | .... I $L(NODEC,";")=4 S CHK=1 Q ; at collection date
|
|---|
| 79 | .. I 'CHK K RESULTS(ITEM)
|
|---|
| 80 | S NEXT=$O(RESULTS(PAR))
|
|---|
| 81 | I NEXT="" S OK=0 Q
|
|---|
| 82 | I NEXT]PARSTOP S OK=0 Q
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | SCRAPS(CONDS,RESULTS,OK) ;
|
|---|
| 86 | N ITEM,ITEMC
|
|---|
| 87 | S OK=1
|
|---|
| 88 | S ITEM=""
|
|---|
| 89 | F S ITEM=$O(RESULTS(ITEM)) Q:ITEM="" D
|
|---|
| 90 | . S ITEMC=$P(ITEM,";",1,2)
|
|---|
| 91 | . I ITEMC="M;A",$D(CONDS("MIR")) Q
|
|---|
| 92 | . I ITEMC="M;M",$D(CONDS("MIR")) Q
|
|---|
| 93 | . I '$D(CONDS("X",ITEMC)) K RESULTS(ITEM)
|
|---|
| 94 | I '$L($O(RESULTS(""))) S OK=0 Q
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | NOTEQUAL(CONDS,RESULTS,OK) ;
|
|---|
| 98 | ; check not equal condition for pointer values
|
|---|
| 99 | N FILE,ITEM,START,STOP,TYPE
|
|---|
| 100 | S OK=1
|
|---|
| 101 | S ITEM=""
|
|---|
| 102 | F S ITEM=$O(CONDS(0,ITEM)) Q:ITEM="" D Q:'OK
|
|---|
| 103 | . S TYPE=$E(ITEM),FILE=$E(ITEM,3),START=TYPE_";"_FILE,STOP=TYPE_";"_FILE_";Z"
|
|---|
| 104 | . K RESULTS(ITEM)
|
|---|
| 105 | . S NEXT=$O(RESULTS(START))
|
|---|
| 106 | . I NEXT="" S OK=0 Q
|
|---|
| 107 | . I NEXT]STOP S OK=0 Q
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | EQUAL(CONDS,RESULTS,OK) ;
|
|---|
| 111 | ; check equal condition for pointer values
|
|---|
| 112 | N FILE,ITEM,ITEMC,NEXT,START,STOP,TYPE
|
|---|
| 113 | S OK=1
|
|---|
| 114 | S ITEM=""
|
|---|
| 115 | F S ITEM=$O(CONDS(1,ITEM)) Q:ITEM="" D
|
|---|
| 116 | . S TYPE=$E(ITEM),FILE=$E(ITEM,3),START=TYPE_";"_FILE,STOP=TYPE_";"_FILE_";Z"
|
|---|
| 117 | . S ITEMC=START
|
|---|
| 118 | . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]STOP D
|
|---|
| 119 | .. I ITEMC=ITEM Q
|
|---|
| 120 | .. K RESULTS(ITEMC)
|
|---|
| 121 | S NEXT=$O(RESULTS(START))
|
|---|
| 122 | I NEXT="" S OK=0 Q
|
|---|
| 123 | I NEXT]STOP S OK=0 Q
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
| 126 | AC(CONDS,RESULTS,OK) ;
|
|---|
| 127 | ; check conditions for AP categories
|
|---|
| 128 | N CAT,CATEGORY,ITEM,ITEMC,NODE,NOTEQUAL,SUB
|
|---|
| 129 | S OK=1
|
|---|
| 130 | S ITEM=""
|
|---|
| 131 | F S ITEM=$O(CONDS("AC",ITEM)) Q:ITEM="" D
|
|---|
| 132 | . S CATEGORY=$P(ITEM,"=",2)
|
|---|
| 133 | . I '$L(CATEGORY) Q
|
|---|
| 134 | . S CATEGORY=$E(CATEGORY,2)
|
|---|
| 135 | . S NOTEQUAL=0
|
|---|
| 136 | . I $L($P(ITEM,"'=",2)) S NOTEQUAL=1
|
|---|
| 137 | . S ITEMC="A"
|
|---|
| 138 | . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;Z" D
|
|---|
| 139 | .. I ITEMC["A;T;" Q
|
|---|
| 140 | .. S NODE=""
|
|---|
| 141 | .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
|
|---|
| 142 | ... S SUB=$P(NODE,";",2)
|
|---|
| 143 | ... I SUB=33!(SUB=80) S CAT="A"
|
|---|
| 144 | ... E S CAT=$E(SUB)
|
|---|
| 145 | ... I NOTEQUAL,CAT=CATEGORY K RESULTS(ITEMC,NODE) Q
|
|---|
| 146 | ... I 'NOTEQUAL,CAT'=CATEGORY K RESULTS(ITEMC,NODE) Q
|
|---|
| 147 | I '$L($O(RESULTS(""))) S OK=0 Q
|
|---|
| 148 | Q
|
|---|
| 149 | ;
|
|---|
| 150 | MC(CONDS,RESULTS,OK) ;
|
|---|
| 151 | ; check conditions for Micro categories
|
|---|
| 152 | N CATEGORY,CATSUB,ITEM,ITEMC,NEXT,NODE,NOTEQUAL,SUB
|
|---|
| 153 | S OK=1
|
|---|
| 154 | S ITEM=""
|
|---|
| 155 | F S ITEM=$O(CONDS("MC",ITEM)) Q:ITEM="" D
|
|---|
| 156 | . S CATEGORY=$P(ITEM,"=",2)
|
|---|
| 157 | . I '$L(CATEGORY) Q
|
|---|
| 158 | . S CATEGORY=$E(CATEGORY,2)
|
|---|
| 159 | . S CATSUB=$$CATSUB^LRPXAPIU(CATEGORY,"M")
|
|---|
| 160 | . S NOTEQUAL=0
|
|---|
| 161 | . I $L($P(ITEM,"'=",2)) S NOTEQUAL=1
|
|---|
| 162 | . S ITEMC="M"
|
|---|
| 163 | . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"M;Z" D
|
|---|
| 164 | .. I ITEMC["M;T;" Q
|
|---|
| 165 | .. I ITEMC["M;S;" Q
|
|---|
| 166 | .. S NODE=""
|
|---|
| 167 | .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
|
|---|
| 168 | ... S SUB=$P(NODE,";",4)
|
|---|
| 169 | ... I NOTEQUAL,SUB=CATSUB K RESULTS(ITEMC,NODE) Q
|
|---|
| 170 | ... I 'NOTEQUAL,SUB'=CATSUB K RESULTS(ITEMC,NODE) Q
|
|---|
| 171 | S NEXT=$O(RESULTS("M"))
|
|---|
| 172 | I NEXT="" S OK=0 Q
|
|---|
| 173 | I NEXT]"M;S" S OK=0 Q
|
|---|
| 174 | Q
|
|---|
| 175 | ;
|
|---|
| 176 | AS(CONDS,RESULTS,OK) ;
|
|---|
| 177 | ; check conditions for AP specimen
|
|---|
| 178 | N CHECK,ITEM,ITEMC,NEXT,S
|
|---|
| 179 | S OK=1
|
|---|
| 180 | S ITEM=""
|
|---|
| 181 | F S ITEM=$O(CONDS("AS",ITEM)) Q:ITEM="" D
|
|---|
| 182 | . I $E(ITEM,2)="'" D Q
|
|---|
| 183 | .. ; good if the specimen text is not present for this collection
|
|---|
| 184 | .. S ITEMC="A;S;1"
|
|---|
| 185 | .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;S;Z" D
|
|---|
| 186 | ... S S=$P(ITEMC,"1.",2)
|
|---|
| 187 | ... S CHECK="I "_ITEM
|
|---|
| 188 | ... X CHECK I '$T K RESULTS(ITEMC)
|
|---|
| 189 | . ; good if any of the specimen text for this collection have a matching text
|
|---|
| 190 | . I $O(RESULTS("A;S;1"))="" Q
|
|---|
| 191 | . I $O(RESULTS("A;S;1"))]"A;S;Z" Q
|
|---|
| 192 | . S OK=0
|
|---|
| 193 | . S ITEMC="A;S;1"
|
|---|
| 194 | . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;S;Z" D
|
|---|
| 195 | .. S S=$P(ITEMC,"1.",2)
|
|---|
| 196 | .. S CHECK="I "_ITEM
|
|---|
| 197 | .. X CHECK I '$T K RESULTS(ITEMC)
|
|---|
| 198 | S NEXT=$O(RESULTS("A;S;"))
|
|---|
| 199 | I NEXT="" S OK=0 Q
|
|---|
| 200 | I NEXT]"A;S;Z" S OK=0 Q
|
|---|
| 201 | S OK=1
|
|---|
| 202 | Q
|
|---|
| 203 | ;
|
|---|
| 204 | MIR(CONDS,RESULTS,OK) ;
|
|---|
| 205 | ; check conditions for antimicrobial results and interpretations
|
|---|
| 206 | ; uses MCHK within this scope
|
|---|
| 207 | N ABNODE,ABTYPE,CHECK,I,ITEM,ITEMC,NEXTA,NEXTM,NODE,R,START,STOP
|
|---|
| 208 | S OK=0
|
|---|
| 209 | F ABTYPE="A","M" D MCHK(ABTYPE)
|
|---|
| 210 | S NEXTA=$O(RESULTS("M;A"))
|
|---|
| 211 | S NEXTM=$O(RESULTS("M;M"))
|
|---|
| 212 | I NEXTA="",NEXTM="" Q
|
|---|
| 213 | I NEXTA="",NEXTM]"M;M;Z" Q
|
|---|
| 214 | I NEXTA]"M;A;Z",NEXTM="" Q
|
|---|
| 215 | I NEXTA]"M;A;Z",NEXTM]"M;M;Z" Q
|
|---|
| 216 | S OK=1
|
|---|
| 217 | Q
|
|---|
| 218 | MCHK(ABTYPE) ; within scope of MIR
|
|---|
| 219 | S START="M;"_ABTYPE
|
|---|
| 220 | S STOP=START_";Z"
|
|---|
| 221 | S ITEM=""
|
|---|
| 222 | F S ITEM=$O(CONDS("MIR",ITEM)) Q:ITEM="" D
|
|---|
| 223 | . I $E(ITEM,2)="'" D Q
|
|---|
| 224 | .. ; good if the interpretation/result is not present for this collection
|
|---|
| 225 | .. S ITEMC=START
|
|---|
| 226 | .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]STOP D
|
|---|
| 227 | ... S NODE=""
|
|---|
| 228 | ... F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
|
|---|
| 229 | .... S ABNODE=$$REFVAL^LRPXAPI(NODE)
|
|---|
| 230 | .... I ABTYPE="A" D
|
|---|
| 231 | ..... S I=$P(ABNODE,U,2)
|
|---|
| 232 | ..... S R=$P(ABNODE,U)
|
|---|
| 233 | .... E D
|
|---|
| 234 | ..... S R=$P(ABNODE,U)
|
|---|
| 235 | ..... S I=R
|
|---|
| 236 | .... S CHECK="I "_ITEM
|
|---|
| 237 | .... X CHECK I $T Q
|
|---|
| 238 | .... K RESULTS(ITEMC,NODE)
|
|---|
| 239 | . ; good if any of the interpretations/results have matching conditions
|
|---|
| 240 | . I $O(RESULTS(START))="" Q
|
|---|
| 241 | . I $O(RESULTS(START))]STOP Q
|
|---|
| 242 | . S ITEMC=START
|
|---|
| 243 | . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]STOP D
|
|---|
| 244 | .. S NODE=""
|
|---|
| 245 | .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
|
|---|
| 246 | ... S ABNODE=$$REFVAL^LRPXAPI(NODE)
|
|---|
| 247 | ... S I=$P(ABNODE,U,2)
|
|---|
| 248 | ... S R=$P(ABNODE,U)
|
|---|
| 249 | ... S CHECK="I "_ITEM
|
|---|
| 250 | ... X CHECK I '$T K RESULTS(ITEMC,NODE)
|
|---|
| 251 | Q
|
|---|
| 252 | ;
|
|---|
