LRPXAPI1.m

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 ---LRPXAPI1   8123     printed  Mar 13, 2025@21:23:58                                                                                                                                                                                                    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