LRPXAPI3 ;SLC/STAFF Lab Extract API code - Micro and AP ;10/28/03 11:29
;;5.2;LAB SERVICE;**295**;Sep 27, 1994
;
TESTS(INFO,DFN,TYPE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
; returns AP or Micro items on a patient in array INFO
N CNT,CONDOK,CONDS,DATE,NMSP,OK,STOP K CONDS
S NMSP=$G(INFO) K INFO S INFO=""
; return all info in ^TMP(NMSP,$J
I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S INFO=NMSP
D DATES^LRPXAPIU(.DATE1,.DATE2)
S CONDOK=+$P($G(NEXT),U,2)
S NEXT=$G(NEXT,TYPE)
I NEXT'=TYPE S NEXT=$P(NEXT,U,3)
I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE)
S STOP=TYPE_"Z"
S CNT=0
F S NEXT=$O(^PXRMINDX(63,"PI",DFN,NEXT)) Q:NEXT="" Q:NEXT]STOP D Q:CNT'<MAX
. I $E(NEXT)'=TYPE Q
. S OK=0
. I '$L(COND) D Q:'OK
.. S DATE=+$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
.. I 'DATE Q
.. I DATE>DATE2 Q
.. S OK=1
. E D Q:'OK
.. S DATE=DATE1
.. F S DATE=$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE)) Q:DATE<1 Q:DATE>DATE2 D Q:OK
... I $$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) S OK=1
. S CNT=CNT+1
. I INFO?1U1UN1.14UNP D Q
.. S ^TMP(INFO,$J,NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
. S INFO(NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
I NEXT]STOP!'$L(NEXT) S NEXT=0
E S NEXT="1^1^"_NEXT ; #^item is used for consistency with other APIs
Q
;
RESULTS(VALUES,DFN,PITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
; returns all AP or Micro results on a patient in array VALUES
; format: date^item^node^data
; where data is item file ien^item name^values on node
N CAT,CATONLY,CATSUB,CONDOK,CNT,DATA,DATE,DONE,ERR,ITEM,ISTOP,NODE,NMSP,OK,TYPE
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
D DATES^LRPXAPIU(.DATE1,.DATE2)
S CONDOK=+$P($G(NEXT),U,2)
S TYPE=$E(PITEM)
S NEXT=+$G(NEXT) I NEXT S DATE2=NEXT
I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
S CAT="",CATSUB=""
S CATONLY=$$CATONLY(COND)
I CATONLY S CAT=$E(COND,$L(COND)-1)
I $L(CAT) D
. S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
. I CATSUB=-1 S CATSUB="" Q
I $L(COND),'CATONLY D Q
. D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
. D TRESULTS(.VALUES,DFN,TYPE,ITEM,MAX,.NEXT,COND,DATE1,DATE2) Q
I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
E S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
S CNT=0
S DONE=0
S DATE=DATE2
F S DATE=$O(^PXRMINDX(63,"PDI",DFN,DATE),-1) Q:DATE="" D Q:DONE
. I DATE1,DATE<DATE1 S DATE="",DONE=1 Q
. S OK=0
. S ITEM=PITEM
. F S ITEM=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM)) Q:ITEM="" Q:ITEM]ISTOP D
.. I $E(ITEM)'=TYPE Q
.. I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
.. S OK=1
.. S NODE=""
.. F S NODE=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)) Q:NODE="" Q:$E(NODE)[TYPE D
... D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
... I VALUES?1U1UN1.14UNP D Q
.... S ^TMP(VALUES,$J,NODE_" "_ITEM)=ITEM_U_NODE_U_DATA
... S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
. I OK S CNT=CNT+1
. I CNT'<MAX S DONE=1 Q
S NEXT=+DATE_U_1
Q
;
TRESULTS(VALUES,DFN,TYPE,ITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
; returns AP or Micro single item results on a patient in array VALUES
N CNT,CONDOK,CONDS,DATA,DATE,NMSP,NODE,OK K CONDS
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^LRPXAPIU(COND,TYPE) Q
I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
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",ITEM,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
. I $L(COND),'$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
. S CNT=CNT+1
. S NODE=""
. F S NODE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)) Q:NODE="" D Q:OK
.. S OK=0
.. D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
.. I VALUES?1U1UN1.14UNP D Q
... S ^TMP(VALUES,$J,-DATE)=DATE_U_ITEM_U_NODE_U_DATA
.. S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
. I CNT'<MAX S OK=1 Q
S NEXT=+DATE_U_1
Q
;
PATIENTS(PATS,TYPE,ITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
; uses PCHK within this scope
; returns patients who have AP or Micro item results in array PATS
N CNT,CONDOK,CONDS,DATE,DFN,DONE,NMSP,OK K CONDS
S NMSP=$G(PATS) K PATS S PATS=""
; return all 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,TYPE) Q
I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
S CNT=0
I '$L(SOURCE) D
. F S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1 D PCHK Q:CNT'<MAX
E D
. F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PCHK Q:CNT'<MAX
S NEXT=+DFN_U_1
Q
PCHK ; within scope of PATIENTS
S DONE=0
S OK=0
S DATE=DATE1
F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1 D Q:DONE
. I DATE>DATE2 S DONE=1 Q
. I '$L(COND) S OK=1,DONE=1 Q
. I '$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
. S OK=0
. I $L($O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,""))) S OK=1,DONE=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
;
ALLPATS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
; uses APATS within this scope
; returns all patients that have lab data
N CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
; if item exists in condition, route to other procedure
I $L(COND) D Q
. S OK=0 F TYPE="C","M","A" D Q:OK ; use first valid type
.. I $$CONDOK^LRPXAPIU(COND,TYPE) S OK=1 Q
. I 'OK Q
. D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
. I TYPE="C" D PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
. D PATIENTS^LRPXAPI3(.PATS,TYPE,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 APATS Q:CNT'<MAX
E D
. F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D APATS Q:CNT'<MAX
S NEXT=+DFN
Q
APATS ; within scope of ALLPATS
S OK=0
S ITEM=""
F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" 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
;
PTS(PATS,TYPE,PITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
; uses PCHK within this scope
; returns patients who have AP or Micro (all or partial type) results in array PATS
N CAT,CATONLY,CATSUB,CNT,CONDOK,CONDS,DATE,DFN,DONE,ERR,ITEM
N ISTOP,NMSP,OK K CONDS
S NMSP=$G(PATS) K PATS S PATS=""
; return all 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,TYPE) Q
S CAT="",CATSUB=""
S CATONLY=$$CATONLY(COND)
I CATONLY S CAT=$E(COND,$L(COND)-1)
I $L(CAT) D
. S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
. I CATSUB=-1 S CATSUB="" Q
I $L(COND),'CATONLY D Q
. D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
. D PATIENTS(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
E S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
S CNT=0
S DONE=0
S ITEM=PITEM
F S ITEM=$O(^PXRMINDX(63,"IP",ITEM)) Q:ITEM="" Q:ITEM]ISTOP D Q:DONE
. I TYPE'=$E(ITEM) S DONE=1 Q
. I '$L(SOURCE) D
.. F S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1 D PT Q:DONE
. E D
.. F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D Q:DONE
... I $D(^PXRMINDX(63,"IP",ITEM,DFN)) D PT
S NEXT=+DFN_U_1
Q
PT ; within scope of PATIENTS
S OK=0
S DATE=DATE1
F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1 D Q:OK
. I DATE>DATE2 Q
. I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
. S OK=1
I OK D
. S CNT=CNT+1
. I CNT'<MAX S DONE=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
;
CATONLY(COND) ; $$(condition) -> 1 if condition is only a category, else 0
I '$L(COND) Q 0
I $L(COND)>6 Q 0
I $E(COND,$L(COND))'="""" Q 0
I $E(COND,1,3)["C=" Q 1
Q 0
;
CATOK(DFN,ITEM,DATE,CATSUB) ; $$(dfn,item,date,cat) -> 1 if any nodes match category, else 0
N NODE,SUB
S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,""))
I NODE="" Q 0
S SUB=$P(NODE,";",2)
I SUB=CATSUB Q 1
I SUB="MI",$P(NODE,";",4)=CATSUB Q 1
I SUB="AY",CATSUB="AU" Q 1
I SUB=80,CATSUB="AU" Q 1
I SUB=33,CATSUB="AU" Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXAPI3 8964 printed Dec 13, 2024@02:19:31 Page 2
LRPXAPI3 ;SLC/STAFF Lab Extract API code - Micro and AP ;10/28/03 11:29
+1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
+2 ;
TESTS(INFO,DFN,TYPE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; returns AP or Micro items on a patient in array INFO
+2 NEW CNT,CONDOK,CONDS,DATE,NMSP,OK,STOP
KILL CONDS
+3 SET NMSP=$GET(INFO)
KILL INFO
SET INFO=""
+4 ; return all info in ^TMP(NMSP,$J
+5 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET INFO=NMSP
+6 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+7 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+8 SET NEXT=$GET(NEXT,TYPE)
+9 IF NEXT'=TYPE
SET NEXT=$PIECE(NEXT,U,3)
+10 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,TYPE)
QUIT
+11 IF $LENGTH(COND)
DO CONDS^LRPXAPI6(.CONDS,COND,TYPE)
+12 SET STOP=TYPE_"Z"
+13 SET CNT=0
+14 FOR
SET NEXT=$ORDER(^PXRMINDX(63,"PI",DFN,NEXT))
if NEXT=""
QUIT
if NEXT]STOP
QUIT
Begin DoDot:1
+15 IF $EXTRACT(NEXT)'=TYPE
QUIT
+16 SET OK=0
+17 IF '$LENGTH(COND)
Begin DoDot:2
+18 SET DATE=+$ORDER(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
+19 IF 'DATE
QUIT
+20 IF DATE>DATE2
QUIT
+21 SET OK=1
End DoDot:2
if 'OK
QUIT
+22 IF '$TEST
Begin DoDot:2
+23 SET DATE=DATE1
+24 FOR
SET DATE=$ORDER(^PXRMINDX(63,"PI",DFN,NEXT,DATE))
if DATE<1
QUIT
if DATE>DATE2
QUIT
Begin DoDot:3
+25 IF $$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE)
SET OK=1
End DoDot:3
if OK
QUIT
End DoDot:2
if 'OK
QUIT
+26 SET CNT=CNT+1
+27 IF INFO?1U1UN1.14UNP
Begin DoDot:2
+28 SET ^TMP(INFO,$JOB,NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
End DoDot:2
QUIT
+29 SET INFO(NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
End DoDot:1
if CNT'<MAX
QUIT
+30 IF NEXT]STOP!'$LENGTH(NEXT)
SET NEXT=0
+31 ; #^item is used for consistency with other APIs
IF '$TEST
SET NEXT="1^1^"_NEXT
+32 QUIT
+33 ;
RESULTS(VALUES,DFN,PITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; returns all AP or Micro results on a patient in array VALUES
+2 ; format: date^item^node^data
+3 ; where data is item file ien^item name^values on node
+4 NEW CAT,CATONLY,CATSUB,CONDOK,CNT,DATA,DATE,DONE,ERR,ITEM,ISTOP,NODE,NMSP,OK,TYPE
+5 SET NMSP=$GET(VALUES)
KILL VALUES
SET VALUES=""
+6 ; return all results in ^TMP(NMSP,$J
+7 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET VALUES=NMSP
+8 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+9 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+10 SET TYPE=$EXTRACT(PITEM)
+11 SET NEXT=+$GET(NEXT)
IF NEXT
SET DATE2=NEXT
+12 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,TYPE)
QUIT
+13 SET CAT=""
SET CATSUB=""
+14 SET CATONLY=$$CATONLY(COND)
+15 IF CATONLY
SET CAT=$EXTRACT(COND,$LENGTH(COND)-1)
+16 IF $LENGTH(CAT)
Begin DoDot:1
+17 SET CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
+18 IF CATSUB=-1
SET CATSUB=""
QUIT
End DoDot:1
+19 IF $LENGTH(COND)
IF 'CATONLY
Begin DoDot:1
+20 DO ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR)
IF ERR
QUIT
+21 DO TRESULTS(.VALUES,DFN,TYPE,ITEM,MAX,.NEXT,COND,DATE1,DATE2)
QUIT
End DoDot:1
QUIT
+22 IF $LENGTH($PIECE(PITEM,";",2))
SET ISTOP=$PIECE(PITEM,";",1,2)_"Z"
+23 IF '$TEST
SET PITEM=$EXTRACT(TYPE)
SET ISTOP=PITEM_"Z"
+24 SET CNT=0
+25 SET DONE=0
+26 SET DATE=DATE2
+27 FOR
SET DATE=$ORDER(^PXRMINDX(63,"PDI",DFN,DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+28 IF DATE1
IF DATE<DATE1
SET DATE=""
SET DONE=1
QUIT
+29 SET OK=0
+30 SET ITEM=PITEM
+31 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PDI",DFN,DATE,ITEM))
if ITEM=""
QUIT
if ITEM]ISTOP
QUIT
Begin DoDot:2
+32 IF $EXTRACT(ITEM)'=TYPE
QUIT
+33 IF $LENGTH(CATSUB)
IF '$$CATOK(DFN,ITEM,DATE,CATSUB)
QUIT
+34 SET OK=1
+35 SET NODE=""
+36 FOR
SET NODE=$ORDER(^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE))
if NODE=""
QUIT
if $EXTRACT(NODE)[TYPE
QUIT
Begin DoDot:3
+37 DO LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
+38 IF VALUES?1U1UN1.14UNP
Begin DoDot:4
+39 SET ^TMP(VALUES,$JOB,NODE_" "_ITEM)=ITEM_U_NODE_U_DATA
End DoDot:4
QUIT
+40 SET VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
End DoDot:3
End DoDot:2
+41 IF OK
SET CNT=CNT+1
+42 IF CNT'<MAX
SET DONE=1
QUIT
End DoDot:1
if DONE
QUIT
+43 SET NEXT=+DATE_U_1
+44 QUIT
+45 ;
TRESULTS(VALUES,DFN,TYPE,ITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; returns AP or Micro single item results on a patient in array VALUES
+2 NEW CNT,CONDOK,CONDS,DATA,DATE,NMSP,NODE,OK
KILL CONDS
+3 SET NMSP=$GET(VALUES)
KILL VALUES
SET VALUES=""
+4 ; return all test results in ^TMP(NMSP,$J
+5 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET VALUES=NMSP
+6 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+7 IF $LENGTH(COND)
IF '$$CONDOK^LRPXAPIU(COND,TYPE)
QUIT
+8 IF $LENGTH(COND)
DO CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
+9 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+10 SET DATE=DATE2
+11 SET NEXT=+$GET(NEXT)
IF NEXT
SET DATE=NEXT
+12 SET CNT=0
+13 SET OK=0
+14 FOR
SET DATE=$ORDER(^PXRMINDX(63,"IP",ITEM,DFN,DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+15 IF DATE<DATE1
SET OK=1
SET DATE=0
QUIT
+16 IF DATE>DATE2
SET OK=1
SET DATE=0
QUIT
+17 IF $LENGTH(COND)
IF '$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE)
QUIT
+18 SET CNT=CNT+1
+19 SET NODE=""
+20 FOR
SET NODE=$ORDER(^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE))
if NODE=""
QUIT
Begin DoDot:2
+21 SET OK=0
+22 DO LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
+23 IF VALUES?1U1UN1.14UNP
Begin DoDot:3
+24 SET ^TMP(VALUES,$JOB,-DATE)=DATE_U_ITEM_U_NODE_U_DATA
End DoDot:3
QUIT
+25 SET VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
End DoDot:2
if OK
QUIT
+26 IF CNT'<MAX
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+27 SET NEXT=+DATE_U_1
+28 QUIT
+29 ;
PATIENTS(PATS,TYPE,ITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; uses PCHK within this scope
+2 ; returns patients who have AP or Micro item results in array PATS
+3 NEW CNT,CONDOK,CONDS,DATE,DFN,DONE,NMSP,OK
KILL CONDS
+4 SET NMSP=$GET(PATS)
KILL PATS
SET PATS=""
+5 ; return all patients in ^TMP(NMSP,$J
+6 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET PATS=NMSP
+7 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+8 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+9 SET NEXT=+$GET(NEXT)
+10 SET DFN=NEXT
+11 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,TYPE)
QUIT
+12 IF $LENGTH(COND)
DO CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
+13 SET CNT=0
+14 IF '$LENGTH(SOURCE)
Begin DoDot:1
+15 FOR
SET DFN=$ORDER(^PXRMINDX(63,"IP",ITEM,DFN))
if DFN<1
QUIT
DO PCHK
if CNT'<MAX
QUIT
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 FOR
SET DFN=$ORDER(@SOURCE@(DFN))
if DFN<1
QUIT
DO PCHK
if CNT'<MAX
QUIT
End DoDot:1
+18 SET NEXT=+DFN_U_1
+19 QUIT
PCHK ; within scope of PATIENTS
+1 SET DONE=0
+2 SET OK=0
+3 SET DATE=DATE1
+4 FOR
SET DATE=$ORDER(^PXRMINDX(63,"IP",ITEM,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 IF '$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE)
QUIT
+8 SET OK=0
+9 IF $LENGTH($ORDER(^PXRMINDX(63,"IP",ITEM,DFN,DATE,"")))
SET OK=1
SET DONE=1
QUIT
End DoDot:1
if DONE
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 ;
ALLPATS(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 CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
+4 ; if item exists in condition, route to other procedure
+5 IF $LENGTH(COND)
Begin DoDot:1
+6 ; use first valid type
SET OK=0
FOR TYPE="C","M","A"
Begin DoDot:2
+7 IF $$CONDOK^LRPXAPIU(COND,TYPE)
SET OK=1
QUIT
End DoDot:2
if OK
QUIT
+8 IF 'OK
QUIT
+9 DO ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR)
IF ERR
QUIT
+10 IF TYPE="C"
DO PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2)
QUIT
+11 DO PATIENTS^LRPXAPI3(.PATS,TYPE,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 APATS
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 APATS
if CNT'<MAX
QUIT
End DoDot:1
+23 SET NEXT=+DFN
+24 QUIT
APATS ; within scope of ALLPATS
+1 SET OK=0
+2 SET ITEM=""
+3 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM))
if ITEM=""
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 ;
PTS(PATS,TYPE,PITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
+1 ; uses PCHK within this scope
+2 ; returns patients who have AP or Micro (all or partial type) results in array PATS
+3 NEW CAT,CATONLY,CATSUB,CNT,CONDOK,CONDS,DATE,DFN,DONE,ERR,ITEM
+4 NEW ISTOP,NMSP,OK
KILL CONDS
+5 SET NMSP=$GET(PATS)
KILL PATS
SET PATS=""
+6 ; return all patients in ^TMP(NMSP,$J
+7 IF NMSP?1U1UN1.14UNP
KILL ^TMP(NMSP,$JOB)
SET PATS=NMSP
+8 DO DATES^LRPXAPIU(.DATE1,.DATE2)
+9 SET CONDOK=+$PIECE($GET(NEXT),U,2)
+10 SET NEXT=+$GET(NEXT)
+11 SET DFN=NEXT
+12 IF $LENGTH(COND)
IF 'CONDOK
IF '$$CONDOK^LRPXAPIU(COND,TYPE)
QUIT
+13 SET CAT=""
SET CATSUB=""
+14 SET CATONLY=$$CATONLY(COND)
+15 IF CATONLY
SET CAT=$EXTRACT(COND,$LENGTH(COND)-1)
+16 IF $LENGTH(CAT)
Begin DoDot:1
+17 SET CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
+18 IF CATSUB=-1
SET CATSUB=""
QUIT
End DoDot:1
+19 IF $LENGTH(COND)
IF 'CATONLY
Begin DoDot:1
+20 DO ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR)
IF ERR
QUIT
+21 DO PATIENTS(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2)
QUIT
End DoDot:1
QUIT
+22 IF $LENGTH($PIECE(PITEM,";",2))
SET ISTOP=$PIECE(PITEM,";",1,2)_"Z"
+23 IF '$TEST
SET PITEM=$EXTRACT(TYPE)
SET ISTOP=PITEM_"Z"
+24 SET CNT=0
+25 SET DONE=0
+26 SET ITEM=PITEM
+27 FOR
SET ITEM=$ORDER(^PXRMINDX(63,"IP",ITEM))
if ITEM=""
QUIT
if ITEM]ISTOP
QUIT
Begin DoDot:1
+28 IF TYPE'=$EXTRACT(ITEM)
SET DONE=1
QUIT
+29 IF '$LENGTH(SOURCE)
Begin DoDot:2
+30 FOR
SET DFN=$ORDER(^PXRMINDX(63,"IP",ITEM,DFN))
if DFN<1
QUIT
DO PT
if DONE
QUIT
End DoDot:2
+31 IF '$TEST
Begin DoDot:2
+32 FOR
SET DFN=$ORDER(@SOURCE@(DFN))
if DFN<1
QUIT
Begin DoDot:3
+33 IF $DATA(^PXRMINDX(63,"IP",ITEM,DFN))
DO PT
End DoDot:3
if DONE
QUIT
End DoDot:2
End DoDot:1
if DONE
QUIT
+34 SET NEXT=+DFN_U_1
+35 QUIT
PT ; within scope of PATIENTS
+1 SET OK=0
+2 SET DATE=DATE1
+3 FOR
SET DATE=$ORDER(^PXRMINDX(63,"IP",ITEM,DFN,DATE))
if DATE<1
QUIT
Begin DoDot:1
+4 IF DATE>DATE2
QUIT
+5 IF $LENGTH(CATSUB)
IF '$$CATOK(DFN,ITEM,DATE,CATSUB)
QUIT
+6 SET OK=1
End DoDot:1
if OK
QUIT
+7 IF OK
Begin DoDot:1
+8 SET CNT=CNT+1
+9 IF CNT'<MAX
SET DONE=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 ;
CATONLY(COND) ; $$(condition) -> 1 if condition is only a category, else 0
+1 IF '$LENGTH(COND)
QUIT 0
+2 IF $LENGTH(COND)>6
QUIT 0
+3 IF $EXTRACT(COND,$LENGTH(COND))'=""""
QUIT 0
+4 IF $EXTRACT(COND,1,3)["C="
QUIT 1
+5 QUIT 0
+6 ;
CATOK(DFN,ITEM,DATE,CATSUB) ; $$(dfn,item,date,cat) -> 1 if any nodes match category, else 0
+1 NEW NODE,SUB
+2 SET NODE=$ORDER(^PXRMINDX(63,"PI",DFN,ITEM,DATE,""))
+3 IF NODE=""
QUIT 0
+4 SET SUB=$PIECE(NODE,";",2)
+5 IF SUB=CATSUB
QUIT 1
+6 IF SUB="MI"
IF $PIECE(NODE,";",4)=CATSUB
QUIT 1
+7 IF SUB="AY"
IF CATSUB="AU"
QUIT 1
+8 IF SUB=80
IF CATSUB="AU"
QUIT 1
+9 IF SUB=33
IF CATSUB="AU"
QUIT 1
+10 QUIT 0
