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