source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRPXAPI3.m@ 861

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