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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXAPI1 8123 printed Nov 22, 2024@17:29:33 Page 2
LRPXAPI1 ;SLC/STAFF Lab Extract API code ;10/28/03 11:29
+1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
+2 ;
TESTS(TESTS,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; returns lab tests on a patient
+2 ; returned in array TESTS
+3 NEW CNT,CONDOK,DATA,DATE,ERR,NMSP
KILL DATA
+4 SET NMSP=$GET(TESTS)
KILL TESTS
SET TESTS=""
+5 ; return all tests in ^TMP(NMSP,$J
+6 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET TESTS=NMSP
+7 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+8 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+9 SET NEXT=+$GET(NEXT)
+10 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,"C")
QUIT
+11 SET CNT=0
+12 FOR
SET NEXT=$ORDER(^PXRMINDX(63,"PI",DFN,NEXT))
if NEXT<1
QUIT
Begin DoDot:1
+13 SET DATE=+$ORDER(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
+14 IF 'DATE
QUIT
+15 IF DATE>DATE2
QUIT
+16 IF $LENGTH(COND)
DO VALUE^LRPXAPI2(.DATA,DFN,DATE,NEXT,COND,.ERR)
IF ERR
QUIT
+17 SET CNT=CNT+1
+18 IF TESTS?1U1UN1.14UNP
Begin DoDot:2
+19 SET ^TMP(TESTS,$JOB,NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
End DoDot:2
QUIT
+20 SET TESTS(NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
End DoDot:1
if CNT'<MAX
QUIT
+21 SET NEXT=+NEXT_U_1
+22 QUIT
+23 ;
RESULTS(VALUES,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; returns all lab results on a patient
+2 ; returned in array VALUES
+3 ; format: date^test^comment^results
+4 ; date is collection date/time
+5 ; test is file 60 ien
+6 ; comment is 1 (exists) or 0 (no comment)
+7 ; results are result node (value^flag^...)
+8 NEW CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,LRIDT1,NMSP,OK,RESULT,TEST
+9 SET NMSP=$GET(VALUES)
KILL VALUES
SET VALUES=""
+10 ; return all results in ^TMP(NMSP,$J
+11 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET VALUES=NMSP
+12 SET LRDFN=$$LRDFN^LRPXAPIU(DFN)
+13 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+14 SET LRIDT=$$LRIDT^LRPXAPIU(DATE2)
+15 SET LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
+16 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+17 SET NEXT=+$GET(NEXT)
IF NEXT
SET LRIDT=NEXT
+18 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,"C")
QUIT
+19 IF $EXTRACT(COND)="|"
SET COND=$EXTRACT(COND,2,245)
+20 IF $EXTRACT(COND)="~"
SET COND=$EXTRACT(COND,2,245)
+21 IF $LENGTH(COND)
SET COND=$$REPLACE^LRPXAPI2("I "_COND)
+22 SET CNT=0
+23 SET OK=0
+24 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
if LRIDT<1
QUIT
Begin DoDot:1
+25 IF '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT)
QUIT
+26 IF LRIDT<1
SET OK=1
SET LRIDT=0
QUIT
+27 IF LRIDT1
IF LRIDT>LRIDT1
SET OK=1
SET LRIDT=0
QUIT
+28 SET CNT=CNT+1
+29 SET DATE=$$LRIDT^LRPXAPIU(LRIDT)
+30 SET COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
+31 SET LRDN=1
+32 FOR
SET LRDN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRDN))
if LRDN<1
QUIT
SET RESULT=^(LRDN)
Begin DoDot:2
+33 SET TEST=$$TEST^LRPXAPIU(LRDN)
+34 IF 'TEST
QUIT
+35 IF $LENGTH(COND)
DO LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR)
IF ERR
QUIT
+36 IF '$TEST
SET DATA=RESULT
+37 IF VALUES?1U1UN1.14UNP
Begin DoDot:3
+38 SET ^TMP(VALUES,$JOB,LRIDT_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
End DoDot:3
QUIT
+39 SET VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
End DoDot:2
+40 IF CNT'<MAX
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+41 SET NEXT=+LRIDT_U_1
+42 QUIT
+43 ;
TRESULTS(VALUES,DFN,TEST,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; returns a lab test's results on a patient
+2 ; returned in array VALUES
+3 ; format: date^test^comment^results
+4 ; date is collection date/time
+5 ; test is file 60 ien
+6 ; comment is 1 (exists) or 0 (no comment)
+7 ; results are result node (value^flag^...)
+8 NEW CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
+9 SET NMSP=$GET(VALUES)
KILL VALUES
SET VALUES=""
+10 ; return all test results in ^TMP(NMSP,$J
+11 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET VALUES=NMSP
+12 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+13 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,"C")
QUIT
+14 IF $LENGTH(COND)
Begin DoDot:1
+15 IF $EXTRACT(COND)="|"
SET COND=$EXTRACT(COND,2,245)
+16 IF $EXTRACT(COND)="~"
SET COND=$EXTRACT(COND,2,245)
+17 SET COND=$$REPLACE^LRPXAPI2("I "_COND)
End DoDot:1
+18 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+19 SET DATE=DATE2
+20 SET NEXT=+$GET(NEXT)
IF NEXT
SET DATE=NEXT
+21 SET CNT=0
+22 SET OK=0
+23 FOR
SET DATE=$ORDER(^PXRMINDX(63,"IP",TEST,DFN,DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+24 IF DATE<DATE1
SET OK=1
SET DATE=0
QUIT
+25 IF DATE>DATE2
SET OK=1
SET DATE=0
QUIT
+26 SET NODE=$ORDER(^PXRMINDX(63,"IP",TEST,DFN,DATE,1))
+27 SET LRDFN=+$PIECE(NODE,";")
+28 SET LRIDT=+$PIECE(NODE,";",3)
+29 SET COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
+30 SET NODE=""
+31 FOR
SET NODE=$ORDER(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE))
if NODE=""
QUIT
Begin DoDot:2
+32 SET LRDN=+$PIECE(NODE,";",4)
+33 DO LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR)
IF ERR
QUIT
+34 SET CNT=CNT+1
+35 IF VALUES?1U1UN1.14UNP
Begin DoDot:3
+36 SET ^TMP(VALUES,$JOB,-DATE)=DATE_U_TEST_U_COMMENT_U_DATA
End DoDot:3
QUIT
+37 SET VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
+38 IF CNT'<MAX
SET OK=1
QUIT
End DoDot:2
if OK
QUIT
End DoDot:1
if OK
QUIT
+39 SET NEXT=+DATE_U_1
+40 QUIT
+41 ;
PATIENTS(PATS,TEST,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; uses PATS within this scope
+2 ; returns patients who have a test result
+3 ; returned in array PATS
+4 ; format: DFN^patient name
+5 NEW CNT,CONDOK,DATA,DATE,DFN,DONE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
+6 SET NMSP=$GET(PATS)
KILL PATS
SET PATS=""
+7 ; return patients in ^TMP(NMSP,$J
+8 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET PATS=NMSP
+9 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+10 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+11 SET NEXT=+$GET(NEXT)
+12 SET DFN=NEXT
+13 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,"C")
QUIT
+14 IF $EXTRACT(COND)="|"
SET COND=$EXTRACT(COND,2,245)
+15 IF $EXTRACT(COND)="~"
SET COND=$EXTRACT(COND,2,245)
+16 IF $LENGTH(COND)
SET COND=$$REPLACE^LRPXAPI2("I "_COND)
+17 SET CNT=0
+18 IF '$LENGTH(SOURCE)
Begin DoDot:1
+19 FOR
SET DFN=$ORDER(^PXRMINDX(63,"IP",TEST,DFN))
if DFN<1
QUIT
DO PATS
if CNT'<MAX
QUIT
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 FOR
SET DFN=$ORDER(@SOURCE@(DFN))
if DFN<1
QUIT
DO PATS
if CNT'<MAX
QUIT
End DoDot:1
+22 SET NEXT=+DFN_U_1
+23 QUIT
PATS ; within scope of PATIENTS
+1 SET DONE=0
+2 SET OK=0
+3 SET DATE=DATE1
+4 FOR
SET DATE=$ORDER(^PXRMINDX(63,"IP",TEST,DFN,DATE))
if DATE<1
QUIT
Begin DoDot:1
+5 IF DATE>DATE2
SET DONE=1
QUIT
+6 IF '$LENGTH(COND)
SET OK=1
SET DONE=1
QUIT
+7 SET OK=0
+8 SET NODE=""
+9 FOR
SET NODE=$ORDER(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE))
if NODE=""
QUIT
Begin DoDot:2
+10 SET LRDFN=+$PIECE(NODE,";")
+11 SET LRIDT=+$PIECE(NODE,";",3)
+12 SET LRDN=+$PIECE(NODE,";",4)
+13 DO LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR)
IF ERR
QUIT
+14 SET OK=1
+15 SET DONE=1
End DoDot:2
if OK
QUIT
End DoDot:1
if DONE
QUIT
+16 IF OK
Begin DoDot:1
+17 SET CNT=CNT+1
+18 IF PATS?1U1UN1.14UNP
Begin DoDot:2
+19 SET ^TMP(PATS,$JOB,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
End DoDot:2
QUIT
+20 SET PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
End DoDot:1
+21 QUIT
+22 ;
PTS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; uses APATS within this scope
+2 ; returns all patients that have lab data
+3 NEW CONDOK,CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
+4 ; if item exists in condition, route to other procedure
+5 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+6 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,"C")
QUIT
+7 IF $LENGTH(COND)
Begin DoDot:1
+8 DO ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR)
IF ERR
QUIT
+9 DO PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2)
QUIT
End DoDot:1
QUIT
+10 SET NMSP=$GET(PATS)
KILL PATS
SET PATS=""
+11 ; return patients in ^TMP(NMSP,$J
+12 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET PATS=NMSP
+13 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+14 SET NEXT=+$GET(NEXT)
+15 SET DFN=NEXT
+16 SET CNT=0
+17 IF '$LENGTH(SOURCE)
Begin DoDot:1
+18 FOR
SET DFN=$ORDER(^PXRMINDX(63,"PI",DFN))
if DFN<1
QUIT
DO PT
if CNT'<MAX
QUIT
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 FOR
SET DFN=$ORDER(@SOURCE@(DFN))
if DFN<1
QUIT
DO PT
if CNT'<MAX
QUIT
End DoDot:1
+21 SET NEXT=+DFN_U_1
+22 QUIT
PT ; within scope of ALLPATS
+1 SET OK=0
+2 SET ITEM=0
+3 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM<1
QUIT
Begin DoDot:1
+4 SET DATE=DATE1
+5 FOR
SET DATE=+$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE))
if DATE<1
QUIT
Begin DoDot:2
+6 IF DATE>DATE2
QUIT
+7 SET OK=1
QUIT
End DoDot:2
if OK
QUIT
End DoDot:1
if OK
QUIT
+8 IF OK
Begin DoDot:1
+9 SET CNT=CNT+1
+10 IF PATS?1U1UN1.14UNP
Begin DoDot:2
+11 SET ^TMP(PATS,$JOB,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
End DoDot:2
QUIT
+12 SET PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
End DoDot:1
+13 QUIT
+14 ;
DATES(DATES,DFN,TYPE,MAX,NEXT,DATE1,DATE2) ; from LRPXAPI
+1 ; returns dates of data occurrence
+2 ; returned in array DATES
+3 NEW CNT,DATE,ITEM,LRDFN,LRIDT,LRIDT1,NMSP,OK,STOP
+4 SET NMSP=$GET(DATES)
KILL DATES
SET DATES=""
+5 ; return all patients in ^TMP(NMSP,$J
+6 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET DATES=NMSP
+7 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+8 SET CNT=0
+9 IF TYPE="C"
Begin DoDot:1
+10 SET LRDFN=$$LRDFN^LRPXAPIU(DFN)
+11 SET LRIDT=$$LRIDT^LRPXAPIU(DATE2)
+12 SET LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
+13 SET NEXT=+$GET(NEXT)
IF NEXT
SET LRIDT=NEXT
+14 SET OK=0
+15 FOR
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
if LRIDT<1
QUIT
Begin DoDot:2
+16 IF '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT)
QUIT
+17 IF LRIDT<1
SET OK=1
SET LRIDT=0
QUIT
+18 IF LRIDT1
IF LRIDT>LRIDT1
SET OK=1
SET LRIDT=0
QUIT
+19 SET DATE=$$LRIDT^LRPXAPIU(LRIDT)
+20 SET CNT=CNT+1
+21 IF CNT'<MAX
SET OK=1
+22 IF DATES?1U1UN1.14UNP
SET ^TMP(DATES,$JOB,-DATE)=DATE
QUIT
+23 SET DATES(-DATE)=DATE
End DoDot:2
if OK
QUIT
+24 SET NEXT=+LRIDT
End DoDot:1
QUIT
+25 SET DATE=DATE2
+26 SET NEXT=+$GET(NEXT)
IF NEXT
SET DATE=NEXT
+27 SET OK=0
+28 FOR
SET DATE=$ORDER(^PXRMINDX(63,"PDI",DFN,DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+29 IF DATE<DATE1
SET OK=1
SET DATE=0
QUIT
+30 SET ITEM=TYPE
SET STOP=TYPE_"ZZZZ"
+31 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PDI",DFN,DATE,ITEM))
if ITEM=""
QUIT
if ITEM]STOP
QUIT
Begin DoDot:2
+32 SET CNT=CNT+1
+33 IF DATES?1U1UN1.14UNP
Begin DoDot:3
+34 SET ^TMP(DATES,$JOB,-DATE)=DATE
End DoDot:3
QUIT
+35 SET DATES(-DATE)=DATE
End DoDot:2
QUIT
+36 IF CNT'<MAX
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+37 SET NEXT=+DATE
+38 QUIT
+39 ;
