239 lines
7.7 KiB
Mathematica
239 lines
7.7 KiB
Mathematica
LRPXAPI1 ;SLC/STAFF Lab Extract API code ;10/28/03 11:29
|
|
;;5.2;LAB SERVICE;**295**;Sep 27, 1994
|
|
;
|
|
TESTS(TESTS,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|
; returns lab tests on a patient
|
|
; returned in array TESTS
|
|
N CNT,CONDOK,DATA,DATE,ERR,NMSP K DATA
|
|
S NMSP=$G(TESTS) K TESTS S TESTS=""
|
|
; return all tests in ^TMP(NMSP,$J
|
|
I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S TESTS=NMSP
|
|
D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|
S CONDOK=+$P($G(NEXT),U,2)
|
|
S NEXT=+$G(NEXT)
|
|
I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|
S CNT=0
|
|
F S NEXT=$O(^PXRMINDX(63,"PI",DFN,NEXT)) Q:NEXT<1 D Q:CNT'<MAX
|
|
. S DATE=+$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
|
|
. I 'DATE Q
|
|
. I DATE>DATE2 Q
|
|
. I $L(COND) D VALUE^LRPXAPI2(.DATA,DFN,DATE,NEXT,COND,.ERR) I ERR Q
|
|
. S CNT=CNT+1
|
|
. I TESTS?1U1UN1.14UNP D Q
|
|
.. S ^TMP(TESTS,$J,NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
|
|
. S TESTS(NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
|
|
S NEXT=+NEXT_U_1
|
|
Q
|
|
;
|
|
RESULTS(VALUES,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|
; returns all lab results on a patient
|
|
; returned in array VALUES
|
|
; format: date^test^comment^results
|
|
; date is collection date/time
|
|
; test is file 60 ien
|
|
; comment is 1 (exists) or 0 (no comment)
|
|
; results are result node (value^flag^...)
|
|
N CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,LRIDT1,NMSP,OK,RESULT,TEST
|
|
S NMSP=$G(VALUES) K VALUES S VALUES=""
|
|
; return all results in ^TMP(NMSP,$J
|
|
I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
|
|
S LRDFN=$$LRDFN^LRPXAPIU(DFN)
|
|
D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|
S LRIDT=$$LRIDT^LRPXAPIU(DATE2)
|
|
S LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
|
|
S CONDOK=+$P($G(NEXT),U,2)
|
|
S NEXT=+$G(NEXT) I NEXT S LRIDT=NEXT
|
|
I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|
I $E(COND)="|" S COND=$E(COND,2,245)
|
|
I $E(COND)="~" S COND=$E(COND,2,245)
|
|
I $L(COND) S COND=$$REPLACE^LRPXAPI2("I "_COND)
|
|
S CNT=0
|
|
S OK=0
|
|
F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:OK
|
|
. I '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT) Q
|
|
. I LRIDT<1 S OK=1,LRIDT=0 Q
|
|
. I LRIDT1,LRIDT>LRIDT1 S OK=1,LRIDT=0 Q
|
|
. S CNT=CNT+1
|
|
. S DATE=$$LRIDT^LRPXAPIU(LRIDT)
|
|
. S COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
|
|
. S LRDN=1
|
|
. F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 S RESULT=^(LRDN) D
|
|
.. S TEST=$$TEST^LRPXAPIU(LRDN)
|
|
.. I 'TEST Q
|
|
.. I $L(COND) D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
|
|
.. E S DATA=RESULT
|
|
.. I VALUES?1U1UN1.14UNP D Q
|
|
... S ^TMP(VALUES,$J,LRIDT_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
|
|
.. S VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
|
|
. I CNT'<MAX S OK=1 Q
|
|
S NEXT=+LRIDT_U_1
|
|
Q
|
|
;
|
|
TRESULTS(VALUES,DFN,TEST,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|
; returns a lab test's results on a patient
|
|
; returned in array VALUES
|
|
; format: date^test^comment^results
|
|
; date is collection date/time
|
|
; test is file 60 ien
|
|
; comment is 1 (exists) or 0 (no comment)
|
|
; results are result node (value^flag^...)
|
|
N CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
|
|
S NMSP=$G(VALUES) K VALUES S VALUES=""
|
|
; return all test results in ^TMP(NMSP,$J
|
|
I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
|
|
S CONDOK=+$P($G(NEXT),U,2)
|
|
I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|
I $L(COND) D
|
|
. I $E(COND)="|" S COND=$E(COND,2,245)
|
|
. I $E(COND)="~" S COND=$E(COND,2,245)
|
|
. S COND=$$REPLACE^LRPXAPI2("I "_COND)
|
|
D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|
S DATE=DATE2
|
|
S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
|
|
S CNT=0
|
|
S OK=0
|
|
F S DATE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE),-1) Q:DATE="" D Q:OK
|
|
. I DATE<DATE1 S OK=1,DATE=0 Q
|
|
. I DATE>DATE2 S OK=1,DATE=0 Q
|
|
. S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,1))
|
|
. S LRDFN=+$P(NODE,";")
|
|
. S LRIDT=+$P(NODE,";",3)
|
|
. S COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
|
|
. S NODE=""
|
|
. F S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE)) Q:NODE="" D Q:OK
|
|
.. S LRDN=+$P(NODE,";",4)
|
|
.. D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
|
|
.. S CNT=CNT+1
|
|
.. I VALUES?1U1UN1.14UNP D Q
|
|
... S ^TMP(VALUES,$J,-DATE)=DATE_U_TEST_U_COMMENT_U_DATA
|
|
.. S VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
|
|
.. I CNT'<MAX S OK=1 Q
|
|
S NEXT=+DATE_U_1
|
|
Q
|
|
;
|
|
PATIENTS(PATS,TEST,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|
; uses PATS within this scope
|
|
; returns patients who have a test result
|
|
; returned in array PATS
|
|
; format: DFN^patient name
|
|
N CNT,CONDOK,DATA,DATE,DFN,DONE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
|
|
S NMSP=$G(PATS) K PATS S PATS=""
|
|
; return patients in ^TMP(NMSP,$J
|
|
I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
|
|
D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|
S CONDOK=+$P($G(NEXT),U,2)
|
|
S NEXT=+$G(NEXT)
|
|
S DFN=NEXT
|
|
I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|
I $E(COND)="|" S COND=$E(COND,2,245)
|
|
I $E(COND)="~" S COND=$E(COND,2,245)
|
|
I $L(COND) S COND=$$REPLACE^LRPXAPI2("I "_COND)
|
|
S CNT=0
|
|
I '$L(SOURCE) D
|
|
. F S DFN=$O(^PXRMINDX(63,"IP",TEST,DFN)) Q:DFN<1 D PATS Q:CNT'<MAX
|
|
E D
|
|
. F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PATS Q:CNT'<MAX
|
|
S NEXT=+DFN_U_1
|
|
Q
|
|
PATS ; within scope of PATIENTS
|
|
S DONE=0
|
|
S OK=0
|
|
S DATE=DATE1
|
|
F S DATE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE)) Q:DATE<1 D Q:DONE
|
|
. I DATE>DATE2 S DONE=1 Q
|
|
. I '$L(COND) S OK=1,DONE=1 Q
|
|
. S OK=0
|
|
. S NODE=""
|
|
. F S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE)) Q:NODE="" D Q:OK
|
|
.. S LRDFN=+$P(NODE,";")
|
|
.. S LRIDT=+$P(NODE,";",3)
|
|
.. S LRDN=+$P(NODE,";",4)
|
|
.. D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
|
|
.. S OK=1
|
|
.. S DONE=1
|
|
I OK D
|
|
. S CNT=CNT+1
|
|
. I PATS?1U1UN1.14UNP D Q
|
|
.. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|
. S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|
Q
|
|
;
|
|
PTS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
|
|
; uses APATS within this scope
|
|
; returns all patients that have lab data
|
|
N CONDOK,CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
|
|
; if item exists in condition, route to other procedure
|
|
S CONDOK=+$P($G(NEXT),U,2)
|
|
I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
|
|
I $L(COND) D Q
|
|
. D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
|
|
. D PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
|
|
S NMSP=$G(PATS) K PATS S PATS=""
|
|
; return patients in ^TMP(NMSP,$J
|
|
I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
|
|
D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|
S NEXT=+$G(NEXT)
|
|
S DFN=NEXT
|
|
S CNT=0
|
|
I '$L(SOURCE) D
|
|
. F S DFN=$O(^PXRMINDX(63,"PI",DFN)) Q:DFN<1 D PT Q:CNT'<MAX
|
|
E D
|
|
. F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PT Q:CNT'<MAX
|
|
S NEXT=+DFN_U_1
|
|
Q
|
|
PT ; within scope of ALLPATS
|
|
S OK=0
|
|
S ITEM=0
|
|
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM<1 D Q:OK
|
|
. S DATE=DATE1
|
|
. F S DATE=+$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE<1 D Q:OK
|
|
.. I DATE>DATE2 Q
|
|
.. S OK=1 Q
|
|
I OK D
|
|
. S CNT=CNT+1
|
|
. I PATS?1U1UN1.14UNP D Q
|
|
.. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|
. S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
|
|
Q
|
|
;
|
|
DATES(DATES,DFN,TYPE,MAX,NEXT,DATE1,DATE2) ; from LRPXAPI
|
|
; returns dates of data occurrence
|
|
; returned in array DATES
|
|
N CNT,DATE,ITEM,LRDFN,LRIDT,LRIDT1,NMSP,OK,STOP
|
|
S NMSP=$G(DATES) K DATES S DATES=""
|
|
; return all patients in ^TMP(NMSP,$J
|
|
I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S DATES=NMSP
|
|
D DATES^LRPXAPIU(.DATE1,.DATE2)
|
|
S CNT=0
|
|
I TYPE="C" D Q
|
|
. S LRDFN=$$LRDFN^LRPXAPIU(DFN)
|
|
. S LRIDT=$$LRIDT^LRPXAPIU(DATE2)
|
|
. S LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
|
|
. S NEXT=+$G(NEXT) I NEXT S LRIDT=NEXT
|
|
. S OK=0
|
|
. F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:OK
|
|
.. I '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT) Q
|
|
.. I LRIDT<1 S OK=1,LRIDT=0 Q
|
|
.. I LRIDT1,LRIDT>LRIDT1 S OK=1,LRIDT=0 Q
|
|
.. S DATE=$$LRIDT^LRPXAPIU(LRIDT)
|
|
.. S CNT=CNT+1
|
|
.. I CNT'<MAX S OK=1
|
|
.. I DATES?1U1UN1.14UNP S ^TMP(DATES,$J,-DATE)=DATE Q
|
|
.. S DATES(-DATE)=DATE
|
|
. S NEXT=+LRIDT
|
|
S DATE=DATE2
|
|
S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
|
|
S OK=0
|
|
F S DATE=$O(^PXRMINDX(63,"PDI",DFN,DATE),-1) Q:DATE="" D Q:OK
|
|
. I DATE<DATE1 S OK=1,DATE=0 Q
|
|
. S ITEM=TYPE,STOP=TYPE_"ZZZZ"
|
|
. F S ITEM=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM)) Q:ITEM="" Q:ITEM]STOP D Q
|
|
.. S CNT=CNT+1
|
|
.. I DATES?1U1UN1.14UNP D Q
|
|
... S ^TMP(DATES,$J,-DATE)=DATE
|
|
.. S DATES(-DATE)=DATE
|
|
. I CNT'<MAX S OK=1 Q
|
|
S NEXT=+DATE
|
|
Q
|
|
;
|