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