| 1 | LRPXAPI1 ;SLC/STAFF Lab Extract API code ;10/28/03 11:29
|
|---|
| 2 | ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | TESTS(TESTS,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 5 | ; returns lab tests on a patient
|
|---|
| 6 | ; returned in array TESTS
|
|---|
| 7 | N CNT,CONDOK,DATA,DATE,ERR,NMSP K DATA
|
|---|
| 8 | S NMSP=$G(TESTS) K TESTS S TESTS=""
|
|---|
| 9 | ; return all tests in ^TMP(NMSP,$J
|
|---|
| 10 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S TESTS=NMSP
|
|---|
| 11 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 12 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 13 | S NEXT=+$G(NEXT)
|
|---|
| 14 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|---|
| 15 | S CNT=0
|
|---|
| 16 | F S NEXT=$O(^PXRMINDX(63,"PI",DFN,NEXT)) Q:NEXT<1 D Q:CNT'<MAX
|
|---|
| 17 | . S DATE=+$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
|
|---|
| 18 | . I 'DATE Q
|
|---|
| 19 | . I DATE>DATE2 Q
|
|---|
| 20 | . I $L(COND) D VALUE^LRPXAPI2(.DATA,DFN,DATE,NEXT,COND,.ERR) I ERR Q
|
|---|
| 21 | . S CNT=CNT+1
|
|---|
| 22 | . I TESTS?1U1UN1.14UNP D Q
|
|---|
| 23 | .. S ^TMP(TESTS,$J,NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
|
|---|
| 24 | . S TESTS(NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
|
|---|
| 25 | S NEXT=+NEXT_U_1
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | RESULTS(VALUES,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 29 | ; returns all lab results on a patient
|
|---|
| 30 | ; returned in array VALUES
|
|---|
| 31 | ; format: date^test^comment^results
|
|---|
| 32 | ; date is collection date/time
|
|---|
| 33 | ; test is file 60 ien
|
|---|
| 34 | ; comment is 1 (exists) or 0 (no comment)
|
|---|
| 35 | ; results are result node (value^flag^...)
|
|---|
| 36 | N CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,LRIDT1,NMSP,OK,RESULT,TEST
|
|---|
| 37 | S NMSP=$G(VALUES) K VALUES S VALUES=""
|
|---|
| 38 | ; return all results in ^TMP(NMSP,$J
|
|---|
| 39 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
|
|---|
| 40 | S LRDFN=$$LRDFN^LRPXAPIU(DFN)
|
|---|
| 41 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 42 | S LRIDT=$$LRIDT^LRPXAPIU(DATE2)
|
|---|
| 43 | S LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
|
|---|
| 44 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 45 | S NEXT=+$G(NEXT) I NEXT S LRIDT=NEXT
|
|---|
| 46 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|---|
| 47 | I $E(COND)="|" S COND=$E(COND,2,245)
|
|---|
| 48 | I $E(COND)="~" S COND=$E(COND,2,245)
|
|---|
| 49 | I $L(COND) S COND=$$REPLACE^LRPXAPI2("I "_COND)
|
|---|
| 50 | S CNT=0
|
|---|
| 51 | S OK=0
|
|---|
| 52 | F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:OK
|
|---|
| 53 | . I '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT) Q
|
|---|
| 54 | . I LRIDT<1 S OK=1,LRIDT=0 Q
|
|---|
| 55 | . I LRIDT1,LRIDT>LRIDT1 S OK=1,LRIDT=0 Q
|
|---|
| 56 | . S CNT=CNT+1
|
|---|
| 57 | . S DATE=$$LRIDT^LRPXAPIU(LRIDT)
|
|---|
| 58 | . S COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
|
|---|
| 59 | . S LRDN=1
|
|---|
| 60 | . F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 S RESULT=^(LRDN) D
|
|---|
| 61 | .. S TEST=$$TEST^LRPXAPIU(LRDN)
|
|---|
| 62 | .. I 'TEST Q
|
|---|
| 63 | .. I $L(COND) D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
|
|---|
| 64 | .. E S DATA=RESULT
|
|---|
| 65 | .. I VALUES?1U1UN1.14UNP D Q
|
|---|
| 66 | ... S ^TMP(VALUES,$J,LRIDT_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
|
|---|
| 67 | .. S VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
|
|---|
| 68 | . I CNT'<MAX S OK=1 Q
|
|---|
| 69 | S NEXT=+LRIDT_U_1
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | TRESULTS(VALUES,DFN,TEST,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 73 | ; returns a lab test's results on a patient
|
|---|
| 74 | ; returned in array VALUES
|
|---|
| 75 | ; format: date^test^comment^results
|
|---|
| 76 | ; date is collection date/time
|
|---|
| 77 | ; test is file 60 ien
|
|---|
| 78 | ; comment is 1 (exists) or 0 (no comment)
|
|---|
| 79 | ; results are result node (value^flag^...)
|
|---|
| 80 | N CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
|
|---|
| 81 | S NMSP=$G(VALUES) K VALUES S VALUES=""
|
|---|
| 82 | ; return all test results in ^TMP(NMSP,$J
|
|---|
| 83 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
|
|---|
| 84 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 85 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|---|
| 86 | I $L(COND) D
|
|---|
| 87 | . I $E(COND)="|" S COND=$E(COND,2,245)
|
|---|
| 88 | . I $E(COND)="~" S COND=$E(COND,2,245)
|
|---|
| 89 | . S COND=$$REPLACE^LRPXAPI2("I "_COND)
|
|---|
| 90 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 91 | S DATE=DATE2
|
|---|
| 92 | S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
|
|---|
| 93 | S CNT=0
|
|---|
| 94 | S OK=0
|
|---|
| 95 | F S DATE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE),-1) Q:DATE="" D Q:OK
|
|---|
| 96 | . I DATE<DATE1 S OK=1,DATE=0 Q
|
|---|
| 97 | . I DATE>DATE2 S OK=1,DATE=0 Q
|
|---|
| 98 | . S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,1))
|
|---|
| 99 | . S LRDFN=+$P(NODE,";")
|
|---|
| 100 | . S LRIDT=+$P(NODE,";",3)
|
|---|
| 101 | . S COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
|
|---|
| 102 | . S NODE=""
|
|---|
| 103 | . F S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE)) Q:NODE="" D Q:OK
|
|---|
| 104 | .. S LRDN=+$P(NODE,";",4)
|
|---|
| 105 | .. D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
|
|---|
| 106 | .. S CNT=CNT+1
|
|---|
| 107 | .. I VALUES?1U1UN1.14UNP D Q
|
|---|
| 108 | ... S ^TMP(VALUES,$J,-DATE)=DATE_U_TEST_U_COMMENT_U_DATA
|
|---|
| 109 | .. S VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
|
|---|
| 110 | .. I CNT'<MAX S OK=1 Q
|
|---|
| 111 | S NEXT=+DATE_U_1
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | PATIENTS(PATS,TEST,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 115 | ; uses PATS within this scope
|
|---|
| 116 | ; returns patients who have a test result
|
|---|
| 117 | ; returned in array PATS
|
|---|
| 118 | ; format: DFN^patient name
|
|---|
| 119 | N CNT,CONDOK,DATA,DATE,DFN,DONE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
|
|---|
| 120 | S NMSP=$G(PATS) K PATS S PATS=""
|
|---|
| 121 | ; return patients in ^TMP(NMSP,$J
|
|---|
| 122 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
|
|---|
| 123 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 124 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 125 | S NEXT=+$G(NEXT)
|
|---|
| 126 | S DFN=NEXT
|
|---|
| 127 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|---|
| 128 | I $E(COND)="|" S COND=$E(COND,2,245)
|
|---|
| 129 | I $E(COND)="~" S COND=$E(COND,2,245)
|
|---|
| 130 | I $L(COND) S COND=$$REPLACE^LRPXAPI2("I "_COND)
|
|---|
| 131 | S CNT=0
|
|---|
| 132 | I '$L(SOURCE) D
|
|---|
| 133 | . F S DFN=$O(^PXRMINDX(63,"IP",TEST,DFN)) Q:DFN<1 D PATS Q:CNT'<MAX
|
|---|
| 134 | E D
|
|---|
| 135 | . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PATS Q:CNT'<MAX
|
|---|
| 136 | S NEXT=+DFN_U_1
|
|---|
| 137 | Q
|
|---|
| 138 | PATS ; within scope of PATIENTS
|
|---|
| 139 | S DONE=0
|
|---|
| 140 | S OK=0
|
|---|
| 141 | S DATE=DATE1
|
|---|
| 142 | F S DATE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE)) Q:DATE<1 D Q:DONE
|
|---|
| 143 | . I DATE>DATE2 S DONE=1 Q
|
|---|
| 144 | . I '$L(COND) S OK=1,DONE=1 Q
|
|---|
| 145 | . S OK=0
|
|---|
| 146 | . S NODE=""
|
|---|
| 147 | . F S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE)) Q:NODE="" D Q:OK
|
|---|
| 148 | .. S LRDFN=+$P(NODE,";")
|
|---|
| 149 | .. S LRIDT=+$P(NODE,";",3)
|
|---|
| 150 | .. S LRDN=+$P(NODE,";",4)
|
|---|
| 151 | .. D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
|
|---|
| 152 | .. S OK=1
|
|---|
| 153 | .. S DONE=1
|
|---|
| 154 | I OK D
|
|---|
| 155 | . S CNT=CNT+1
|
|---|
| 156 | . I PATS?1U1UN1.14UNP D Q
|
|---|
| 157 | .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 158 | . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 159 | Q
|
|---|
| 160 | ;
|
|---|
| 161 | PTS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 162 | ; uses APATS within this scope
|
|---|
| 163 | ; returns all patients that have lab data
|
|---|
| 164 | N CONDOK,CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
|
|---|
| 165 | ; if item exists in condition, route to other procedure
|
|---|
| 166 | S CONDOK=+$P($G(NEXT),U,2)
|
|---|
| 167 | I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|---|
| 168 | I $L(COND) D Q
|
|---|
| 169 | . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
|
|---|
| 170 | . D PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
|
|---|
| 171 | S NMSP=$G(PATS) K PATS S PATS=""
|
|---|
| 172 | ; return patients in ^TMP(NMSP,$J
|
|---|
| 173 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
|
|---|
| 174 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 175 | S NEXT=+$G(NEXT)
|
|---|
| 176 | S DFN=NEXT
|
|---|
| 177 | S CNT=0
|
|---|
| 178 | I '$L(SOURCE) D
|
|---|
| 179 | . F S DFN=$O(^PXRMINDX(63,"PI",DFN)) Q:DFN<1 D PT Q:CNT'<MAX
|
|---|
| 180 | E D
|
|---|
| 181 | . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PT Q:CNT'<MAX
|
|---|
| 182 | S NEXT=+DFN_U_1
|
|---|
| 183 | Q
|
|---|
| 184 | PT ; within scope of ALLPATS
|
|---|
| 185 | S OK=0
|
|---|
| 186 | S ITEM=0
|
|---|
| 187 | F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM<1 D Q:OK
|
|---|
| 188 | . S DATE=DATE1
|
|---|
| 189 | . F S DATE=+$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE<1 D Q:OK
|
|---|
| 190 | .. I DATE>DATE2 Q
|
|---|
| 191 | .. S OK=1 Q
|
|---|
| 192 | I OK D
|
|---|
| 193 | . S CNT=CNT+1
|
|---|
| 194 | . I PATS?1U1UN1.14UNP D Q
|
|---|
| 195 | .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 196 | . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|---|
| 197 | Q
|
|---|
| 198 | ;
|
|---|
| 199 | DATES(DATES,DFN,TYPE,MAX,NEXT,DATE1,DATE2) ; from LRPXAPI
|
|---|
| 200 | ; returns dates of data occurrence
|
|---|
| 201 | ; returned in array DATES
|
|---|
| 202 | N CNT,DATE,ITEM,LRDFN,LRIDT,LRIDT1,NMSP,OK,STOP
|
|---|
| 203 | S NMSP=$G(DATES) K DATES S DATES=""
|
|---|
| 204 | ; return all patients in ^TMP(NMSP,$J
|
|---|
| 205 | I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S DATES=NMSP
|
|---|
| 206 | D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|---|
| 207 | S CNT=0
|
|---|
| 208 | I TYPE="C" D Q
|
|---|
| 209 | . S LRDFN=$$LRDFN^LRPXAPIU(DFN)
|
|---|
| 210 | . S LRIDT=$$LRIDT^LRPXAPIU(DATE2)
|
|---|
| 211 | . S LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
|
|---|
| 212 | . S NEXT=+$G(NEXT) I NEXT S LRIDT=NEXT
|
|---|
| 213 | . S OK=0
|
|---|
| 214 | . F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:OK
|
|---|
| 215 | .. I '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT) Q
|
|---|
| 216 | .. I LRIDT<1 S OK=1,LRIDT=0 Q
|
|---|
| 217 | .. I LRIDT1,LRIDT>LRIDT1 S OK=1,LRIDT=0 Q
|
|---|
| 218 | .. S DATE=$$LRIDT^LRPXAPIU(LRIDT)
|
|---|
| 219 | .. S CNT=CNT+1
|
|---|
| 220 | .. I CNT'<MAX S OK=1
|
|---|
| 221 | .. I DATES?1U1UN1.14UNP S ^TMP(DATES,$J,-DATE)=DATE Q
|
|---|
| 222 | .. S DATES(-DATE)=DATE
|
|---|
| 223 | . S NEXT=+LRIDT
|
|---|
| 224 | S DATE=DATE2
|
|---|
| 225 | S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
|
|---|
| 226 | S OK=0
|
|---|
| 227 | F S DATE=$O(^PXRMINDX(63,"PDI",DFN,DATE),-1) Q:DATE="" D Q:OK
|
|---|
| 228 | . I DATE<DATE1 S OK=1,DATE=0 Q
|
|---|
| 229 | . S ITEM=TYPE,STOP=TYPE_"ZZZZ"
|
|---|
| 230 | . F S ITEM=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM)) Q:ITEM="" Q:ITEM]STOP D Q
|
|---|
| 231 | .. S CNT=CNT+1
|
|---|
| 232 | .. I DATES?1U1UN1.14UNP D Q
|
|---|
| 233 | ... S ^TMP(DATES,$J,-DATE)=DATE
|
|---|
| 234 | .. S DATES(-DATE)=DATE
|
|---|
| 235 | . I CNT'<MAX S OK=1 Q
|
|---|
| 236 | S NEXT=+DATE
|
|---|
| 237 | Q
|
|---|
| 238 | ;
|
|---|
