| [613] | 1 | LRPXAPI3 ;SLC/STAFF Lab Extract API code - Micro and AP ;10/28/03 11:29
|
|---|
| 2 | ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | TESTS(INFO,DFN,TYPE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 5 | ; returns AP or Micro items on a patient in array INFO
|
|---|
| 6 | N CNT,CONDOK,CONDS,DATE,NMSP,OK,STOP K CONDS
|
|---|
| 7 | S NMSP=$G(INFO) K INFO S INFO=""
|
|---|
| 8 | ; return all info in ^TMP(NMSP,$J
|
|---|
| 9 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S INFO=NMSP
|
|---|
| 10 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 11 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 12 | S NEXT=$G(NEXT,TYPE)
|
|---|
| 13 | I NEXT'=TYPE S NEXT=$P(NEXT,U,3)
|
|---|
| 14 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
|
|---|
| 15 | I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE)
|
|---|
| 16 | S STOP=TYPE_"Z"
|
|---|
| 17 | S CNT=0
|
|---|
| 18 | F S NEXT=$O(^PXRMINDX(63,"PI",DFN,NEXT)) Q:NEXT="" Q:NEXT]STOP D Q:CNT'<MAX
|
|---|
| 19 | . I $E(NEXT)'=TYPE Q
|
|---|
| 20 | . S OK=0
|
|---|
| 21 | . I '$L(COND) D Q:'OK
|
|---|
| 22 | .. S DATE=+$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
|
|---|
| 23 | .. I 'DATE Q
|
|---|
| 24 | .. I DATE>DATE2 Q
|
|---|
| 25 | .. S OK=1
|
|---|
| 26 | . E D Q:'OK
|
|---|
| 27 | .. S DATE=DATE1
|
|---|
| 28 | .. F S DATE=$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE)) Q:DATE<1 Q:DATE>DATE2 D Q:OK
|
|---|
| 29 | ... I $$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) S OK=1
|
|---|
| 30 | . S CNT=CNT+1
|
|---|
| 31 | . I INFO?1U1UN1.14UNP D Q
|
|---|
| 32 | .. S ^TMP(INFO,$J,NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
|
|---|
| 33 | . S INFO(NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
|
|---|
| 34 | I NEXT]STOP!'$L(NEXT) S NEXT=0
|
|---|
| 35 | E S NEXT="1^1^"_NEXT ; #^item is used for consistency with other APIs
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | RESULTS(VALUES,DFN,PITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 39 | ; returns all AP or Micro results on a patient in array VALUES
|
|---|
| 40 | ; format: date^item^node^data
|
|---|
| 41 | ; where data is item file ien^item name^values on node
|
|---|
| 42 | N CAT,CATONLY,CATSUB,CONDOK,CNT,DATA,DATE,DONE,ERR,ITEM,ISTOP,NODE,NMSP,OK,TYPE
|
|---|
| 43 | S NMSP=$G(VALUES) K VALUES S VALUES=""
|
|---|
| 44 | ; return all results in ^TMP(NMSP,$J
|
|---|
| 45 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
|
|---|
| 46 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 47 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 48 | S TYPE=$E(PITEM)
|
|---|
| 49 | S NEXT=+$G(NEXT) I NEXT S DATE2=NEXT
|
|---|
| 50 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
|
|---|
| 51 | S CAT="",CATSUB=""
|
|---|
| 52 | S CATONLY=$$CATONLY(COND)
|
|---|
| 53 | I CATONLY S CAT=$E(COND,$L(COND)-1)
|
|---|
| 54 | I $L(CAT) D
|
|---|
| 55 | . S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
|
|---|
| 56 | . I CATSUB=-1 S CATSUB="" Q
|
|---|
| 57 | I $L(COND),'CATONLY D Q
|
|---|
| 58 | . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
|
|---|
| 59 | . D TRESULTS(.VALUES,DFN,TYPE,ITEM,MAX,.NEXT,COND,DATE1,DATE2) Q
|
|---|
| 60 | I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
|
|---|
| 61 | E S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
|
|---|
| 62 | S CNT=0
|
|---|
| 63 | S DONE=0
|
|---|
| 64 | S DATE=DATE2
|
|---|
| 65 | F S DATE=$O(^PXRMINDX(63,"PDI",DFN,DATE),-1) Q:DATE="" D Q:DONE
|
|---|
| 66 | . I DATE1,DATE<DATE1 S DATE="",DONE=1 Q
|
|---|
| 67 | . S OK=0
|
|---|
| 68 | . S ITEM=PITEM
|
|---|
| 69 | . F S ITEM=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM)) Q:ITEM="" Q:ITEM]ISTOP D
|
|---|
| 70 | .. I $E(ITEM)'=TYPE Q
|
|---|
| 71 | .. I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
|
|---|
| 72 | .. S OK=1
|
|---|
| 73 | .. S NODE=""
|
|---|
| 74 | .. F S NODE=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)) Q:NODE="" Q:$E(NODE)[TYPE D
|
|---|
| 75 | ... D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
|
|---|
| 76 | ... I VALUES?1U1UN1.14UNP D Q
|
|---|
| 77 | .... S ^TMP(VALUES,$J,NODE_" "_ITEM)=ITEM_U_NODE_U_DATA
|
|---|
| 78 | ... S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
|
|---|
| 79 | . I OK S CNT=CNT+1
|
|---|
| 80 | . I CNT'<MAX S DONE=1 Q
|
|---|
| 81 | S NEXT=+DATE_U_1
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | TRESULTS(VALUES,DFN,TYPE,ITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 85 | ; returns AP or Micro single item results on a patient in array VALUES
|
|---|
| 86 | N CNT,CONDOK,CONDS,DATA,DATE,NMSP,NODE,OK K CONDS
|
|---|
| 87 | S NMSP=$G(VALUES) K VALUES S VALUES=""
|
|---|
| 88 | ; return all test results in ^TMP(NMSP,$J
|
|---|
| 89 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
|
|---|
| 90 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 91 | I $L(COND),'$$CONDOK^LRPXAPIU(COND,TYPE) Q
|
|---|
| 92 | I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
|
|---|
| 93 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 94 | S DATE=DATE2
|
|---|
| 95 | S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
|
|---|
| 96 | S CNT=0
|
|---|
| 97 | S OK=0
|
|---|
| 98 | F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE),-1) Q:DATE="" D Q:OK
|
|---|
| 99 | . I DATE<DATE1 S OK=1,DATE=0 Q
|
|---|
| 100 | . I DATE>DATE2 S OK=1,DATE=0 Q
|
|---|
| 101 | . I $L(COND),'$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
|
|---|
| 102 | . S CNT=CNT+1
|
|---|
| 103 | . S NODE=""
|
|---|
| 104 | . F S NODE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)) Q:NODE="" D Q:OK
|
|---|
| 105 | .. S OK=0
|
|---|
| 106 | .. D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
|
|---|
| 107 | .. I VALUES?1U1UN1.14UNP D Q
|
|---|
| 108 | ... S ^TMP(VALUES,$J,-DATE)=DATE_U_ITEM_U_NODE_U_DATA
|
|---|
| 109 | .. S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
|
|---|
| 110 | . I CNT'<MAX S OK=1 Q
|
|---|
| 111 | S NEXT=+DATE_U_1
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | PATIENTS(PATS,TYPE,ITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 115 | ; uses PCHK within this scope
|
|---|
| 116 | ; returns patients who have AP or Micro item results in array PATS
|
|---|
| 117 | N CNT,CONDOK,CONDS,DATE,DFN,DONE,NMSP,OK K CONDS
|
|---|
| 118 | S NMSP=$G(PATS) K PATS S PATS=""
|
|---|
| 119 | ; return all patients in ^TMP(NMSP,$J
|
|---|
| 120 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
|
|---|
| 121 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 122 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 123 | S NEXT=+$G(NEXT)
|
|---|
| 124 | S DFN=NEXT
|
|---|
| 125 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
|
|---|
| 126 | I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
|
|---|
| 127 | S CNT=0
|
|---|
| 128 | I '$L(SOURCE) D
|
|---|
| 129 | . F S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1 D PCHK Q:CNT'<MAX
|
|---|
| 130 | E D
|
|---|
| 131 | . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PCHK Q:CNT'<MAX
|
|---|
| 132 | S NEXT=+DFN_U_1
|
|---|
| 133 | Q
|
|---|
| 134 | PCHK ; within scope of PATIENTS
|
|---|
| 135 | S DONE=0
|
|---|
| 136 | S OK=0
|
|---|
| 137 | S DATE=DATE1
|
|---|
| 138 | F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1 D Q:DONE
|
|---|
| 139 | . I DATE>DATE2 S DONE=1 Q
|
|---|
| 140 | . I '$L(COND) S OK=1,DONE=1 Q
|
|---|
| 141 | . I '$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
|
|---|
| 142 | . S OK=0
|
|---|
| 143 | . I $L($O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,""))) S OK=1,DONE=1 Q
|
|---|
| 144 | I OK D
|
|---|
| 145 | . S CNT=CNT+1
|
|---|
| 146 | . I PATS?1U1UN1.14UNP D Q
|
|---|
| 147 | .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 148 | . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 149 | Q
|
|---|
| 150 | ;
|
|---|
| 151 | ALLPATS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 152 | ; uses APATS within this scope
|
|---|
| 153 | ; returns all patients that have lab data
|
|---|
| 154 | N CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
|
|---|
| 155 | ; if item exists in condition, route to other procedure
|
|---|
| 156 | I $L(COND) D Q
|
|---|
| 157 | . S OK=0 F TYPE="C","M","A" D Q:OK ; use first valid type
|
|---|
| 158 | .. I $$CONDOK^LRPXAPIU(COND,TYPE) S OK=1 Q
|
|---|
| 159 | . I 'OK Q
|
|---|
| 160 | . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
|
|---|
| 161 | . I TYPE="C" D PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
|
|---|
| 162 | . D PATIENTS^LRPXAPI3(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
|
|---|
| 163 | S NMSP=$G(PATS) K PATS S PATS=""
|
|---|
| 164 | ; return patients in ^TMP(NMSP,$J
|
|---|
| 165 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
|
|---|
| 166 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 167 | S NEXT=+$G(NEXT)
|
|---|
| 168 | S DFN=NEXT
|
|---|
| 169 | S CNT=0
|
|---|
| 170 | I '$L(SOURCE) D
|
|---|
| 171 | . F S DFN=$O(^PXRMINDX(63,"PI",DFN)) Q:DFN<1 D APATS Q:CNT'<MAX
|
|---|
| 172 | E D
|
|---|
| 173 | . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D APATS Q:CNT'<MAX
|
|---|
| 174 | S NEXT=+DFN
|
|---|
| 175 | Q
|
|---|
| 176 | APATS ; within scope of ALLPATS
|
|---|
| 177 | S OK=0
|
|---|
| 178 | S ITEM=""
|
|---|
| 179 | F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" D Q:OK
|
|---|
| 180 | . S DATE=DATE1
|
|---|
| 181 | . F S DATE=+$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE<1 D Q:OK
|
|---|
| 182 | .. I DATE>DATE2 Q
|
|---|
| 183 | .. S OK=1 Q
|
|---|
| 184 | I OK D
|
|---|
| 185 | . S CNT=CNT+1
|
|---|
| 186 | . I PATS?1U1UN1.14UNP D Q
|
|---|
| 187 | .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 188 | . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 189 | Q
|
|---|
| 190 | ;
|
|---|
| 191 | PTS(PATS,TYPE,PITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 192 | ; uses PCHK within this scope
|
|---|
| 193 | ; returns patients who have AP or Micro (all or partial type) results in array PATS
|
|---|
| 194 | N CAT,CATONLY,CATSUB,CNT,CONDOK,CONDS,DATE,DFN,DONE,ERR,ITEM
|
|---|
| 195 | N ISTOP,NMSP,OK K CONDS
|
|---|
| 196 | S NMSP=$G(PATS) K PATS S PATS=""
|
|---|
| 197 | ; return all patients in ^TMP(NMSP,$J
|
|---|
| 198 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
|
|---|
| 199 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 200 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 201 | S NEXT=+$G(NEXT)
|
|---|
| 202 | S DFN=NEXT
|
|---|
| 203 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
|
|---|
| 204 | S CAT="",CATSUB=""
|
|---|
| 205 | S CATONLY=$$CATONLY(COND)
|
|---|
| 206 | I CATONLY S CAT=$E(COND,$L(COND)-1)
|
|---|
| 207 | I $L(CAT) D
|
|---|
| 208 | . S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
|
|---|
| 209 | . I CATSUB=-1 S CATSUB="" Q
|
|---|
| 210 | I $L(COND),'CATONLY D Q
|
|---|
| 211 | . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
|
|---|
| 212 | . D PATIENTS(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
|
|---|
| 213 | I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
|
|---|
| 214 | E S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
|
|---|
| 215 | S CNT=0
|
|---|
| 216 | S DONE=0
|
|---|
| 217 | S ITEM=PITEM
|
|---|
| 218 | F S ITEM=$O(^PXRMINDX(63,"IP",ITEM)) Q:ITEM="" Q:ITEM]ISTOP D Q:DONE
|
|---|
| 219 | . I TYPE'=$E(ITEM) S DONE=1 Q
|
|---|
| 220 | . I '$L(SOURCE) D
|
|---|
| 221 | .. F S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1 D PT Q:DONE
|
|---|
| 222 | . E D
|
|---|
| 223 | .. F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D Q:DONE
|
|---|
| 224 | ... I $D(^PXRMINDX(63,"IP",ITEM,DFN)) D PT
|
|---|
| 225 | S NEXT=+DFN_U_1
|
|---|
| 226 | Q
|
|---|
| 227 | PT ; within scope of PATIENTS
|
|---|
| 228 | S OK=0
|
|---|
| 229 | S DATE=DATE1
|
|---|
| 230 | F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1 D Q:OK
|
|---|
| 231 | . I DATE>DATE2 Q
|
|---|
| 232 | . I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
|
|---|
| 233 | . S OK=1
|
|---|
| 234 | I OK D
|
|---|
| 235 | . S CNT=CNT+1
|
|---|
| 236 | . I CNT'<MAX S DONE=1
|
|---|
| 237 | . I PATS?1U1UN1.14UNP D Q
|
|---|
| 238 | .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 239 | . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 240 | Q
|
|---|
| 241 | ;
|
|---|
| 242 | CATONLY(COND) ; $$(condition) -> 1 if condition is only a category, else 0
|
|---|
| 243 | I '$L(COND) Q 0
|
|---|
| 244 | I $L(COND)>6 Q 0
|
|---|
| 245 | I $E(COND,$L(COND))'="""" Q 0
|
|---|
| 246 | I $E(COND,1,3)["C=" Q 1
|
|---|
| 247 | Q 0
|
|---|
| 248 | ;
|
|---|
| 249 | CATOK(DFN,ITEM,DATE,CATSUB) ; $$(dfn,item,date,cat) -> 1 if any nodes match category, else 0
|
|---|
| 250 | N NODE,SUB
|
|---|
| 251 | S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,""))
|
|---|
| 252 | I NODE="" Q 0
|
|---|
| 253 | S SUB=$P(NODE,";",2)
|
|---|
| 254 | I SUB=CATSUB Q 1
|
|---|
| 255 | I SUB="MI",$P(NODE,";",4)=CATSUB Q 1
|
|---|
| 256 | I SUB="AY",CATSUB="AU" Q 1
|
|---|
| 257 | I SUB=80,CATSUB="AU" Q 1
|
|---|
| 258 | I SUB=33,CATSUB="AU" Q 1
|
|---|
| 259 | Q 0
|
|---|
