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