Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRPXAPI3

LRPXAPI3.m

Go to the documentation of this file. 
  1. LRPXAPI3 ;SLC/STAFF Lab Extract API code - Micro and AP ;10/28/03  11:29
  1.  ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
  1.  ;
  1. TESTS(INFO,DFN,TYPE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
  1.  ; returns AP or Micro items on a patient in array INFO
  1.  N CNT,CONDOK,CONDS,DATE,NMSP,OK,STOP K CONDS
  1.  S NMSP=$G(INFO) K INFO S INFO=""
  1.  ; return all info in ^TMP(NMSP,$J
  1.  I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S INFO=NMSP
  1.  D DATES^LRPXAPIU(.DATE1,.DATE2)
  1.  S CONDOK=+$P($G(NEXT),U,2)
  1.  S NEXT=$G(NEXT,TYPE)
  1.  I NEXT'=TYPE S NEXT=$P(NEXT,U,3)
  1.  I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
  1.  I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE)
  1.  S STOP=TYPE_"Z"
  1.  S CNT=0
  1.  F  S NEXT=$O(^PXRMINDX(63,"PI",DFN,NEXT)) Q:NEXT=""  Q:NEXT]STOP  D  Q:CNT'<MAX
  1.  . I $E(NEXT)'=TYPE Q
  1.  . S OK=0
  1.  . I '$L(COND) D  Q:'OK
  1.  .. S DATE=+$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
  1.  .. I 'DATE Q
  1.  .. I DATE>DATE2 Q
  1.  .. S OK=1
  1.  . E  D  Q:'OK
  1.  .. S DATE=DATE1
  1.  .. F  S DATE=$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE)) Q:DATE<1  Q:DATE>DATE2  D  Q:OK
  1.  ... I $$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) S OK=1
  1.  . S CNT=CNT+1
  1.  . I INFO?1U1UN1.14UNP D  Q
  1.  .. S ^TMP(INFO,$J,NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
  1.  . S INFO(NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
  1.  I NEXT]STOP!'$L(NEXT) S NEXT=0
  1.  E  S NEXT="1^1^"_NEXT ; #^item is used for consistency with other APIs
  1.  Q
  1.  ;
  1. RESULTS(VALUES,DFN,PITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
  1.  ; returns all AP or Micro results on a patient in array VALUES
  1.  ; format: date^item^node^data
  1.  ; where data is item file ien^item name^values on node
  1.  N CAT,CATONLY,CATSUB,CONDOK,CNT,DATA,DATE,DONE,ERR,ITEM,ISTOP,NODE,NMSP,OK,TYPE
  1.  S NMSP=$G(VALUES) K VALUES S VALUES=""
  1.  ; return all results in ^TMP(NMSP,$J
  1.  I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
  1.  D DATES^LRPXAPIU(.DATE1,.DATE2)
  1.  S CONDOK=+$P($G(NEXT),U,2)
  1.  S TYPE=$E(PITEM)
  1.  S NEXT=+$G(NEXT) I NEXT S DATE2=NEXT
  1.  I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
  1.  S CAT="",CATSUB=""
  1.  S CATONLY=$$CATONLY(COND)
  1.  I CATONLY S CAT=$E(COND,$L(COND)-1)
  1.  I $L(CAT) D
  1.  . S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
  1.  . I CATSUB=-1 S CATSUB="" Q
  1.  I $L(COND),'CATONLY D  Q
  1.  . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
  1.  . D TRESULTS(.VALUES,DFN,TYPE,ITEM,MAX,.NEXT,COND,DATE1,DATE2) Q
  1.  I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
  1.  E  S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
  1.  S CNT=0
  1.  S DONE=0
  1.  S DATE=DATE2
  1.  F  S DATE=$O(^PXRMINDX(63,"PDI",DFN,DATE),-1) Q:DATE=""  D  Q:DONE
  1.  . I DATE1,DATE<DATE1 S DATE="",DONE=1 Q
  1.  . S OK=0
  1.  . S ITEM=PITEM
  1.  . F  S ITEM=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM)) Q:ITEM=""  Q:ITEM]ISTOP  D
  1.  .. I $E(ITEM)'=TYPE Q
  1.  .. I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
  1.  .. S OK=1
  1.  .. S NODE=""
  1.  .. F  S NODE=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)) Q:NODE=""  Q:$E(NODE)[TYPE  D
  1.  ... D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
  1.  ... I VALUES?1U1UN1.14UNP D  Q
  1.  .... S ^TMP(VALUES,$J,NODE_" "_ITEM)=ITEM_U_NODE_U_DATA
  1.  ... S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
  1.  . I OK S CNT=CNT+1
  1.  . I CNT'<MAX S DONE=1 Q
  1.  S NEXT=+DATE_U_1
  1.  Q
  1.  ;
  1. 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
  1.  N CNT,CONDOK,CONDS,DATA,DATE,NMSP,NODE,OK K CONDS
  1.  S NMSP=$G(VALUES) K VALUES S VALUES=""
  1.  ; return all test results in ^TMP(NMSP,$J
  1.  I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
  1.  S CONDOK=+$P($G(NEXT),U,2)
  1.  I $L(COND),'$$CONDOK^LRPXAPIU(COND,TYPE) Q
  1.  I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
  1.  D DATES^LRPXAPIU(.DATE1,.DATE2)
  1.  S DATE=DATE2
  1.  S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
  1.  S CNT=0
  1.  S OK=0
  1.  F  S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE),-1) Q:DATE=""  D  Q:OK
  1.  . I DATE<DATE1 S OK=1,DATE=0 Q
  1.  . I DATE>DATE2 S OK=1,DATE=0 Q
  1.  . I $L(COND),'$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
  1.  . S CNT=CNT+1
  1.  . S NODE=""
  1.  . F  S NODE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)) Q:NODE=""  D  Q:OK
  1.  .. S OK=0
  1.  .. D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
  1.  .. I VALUES?1U1UN1.14UNP D  Q
  1.  ... S ^TMP(VALUES,$J,-DATE)=DATE_U_ITEM_U_NODE_U_DATA
  1.  .. S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
  1.  . I CNT'<MAX S OK=1 Q
  1.  S NEXT=+DATE_U_1
  1.  Q
  1.  ;
  1. PATIENTS(PATS,TYPE,ITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
  1.  ; uses PCHK within this scope
  1.  ; returns patients who have AP or Micro item results in array PATS
  1.  N CNT,CONDOK,CONDS,DATE,DFN,DONE,NMSP,OK K CONDS
  1.  S NMSP=$G(PATS) K PATS S PATS=""
  1.  ; return all patients in ^TMP(NMSP,$J
  1.  I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
  1.  D DATES^LRPXAPIU(.DATE1,.DATE2)
  1.  S CONDOK=+$P($G(NEXT),U,2)
  1.  S NEXT=+$G(NEXT)
  1.  S DFN=NEXT
  1.  I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
  1.  I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
  1.  S CNT=0
  1.  I '$L(SOURCE) D
  1.  . F  S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1  D PCHK Q:CNT'<MAX
  1.  E  D
  1.  . F  S DFN=$O(@SOURCE@(DFN)) Q:DFN<1  D PCHK Q:CNT'<MAX
  1.  S NEXT=+DFN_U_1
  1.  Q
  1. PCHK ; within scope of PATIENTS
  1.  S DONE=0
  1.  S OK=0
  1.  S DATE=DATE1
  1.  F  S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1  D  Q:DONE
  1.  . I DATE>DATE2 S DONE=1 Q
  1.  . I '$L(COND) S OK=1,DONE=1 Q
  1.  . I '$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
  1.  . S OK=0
  1.  . I $L($O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,""))) S OK=1,DONE=1 Q
  1.  I OK D
  1.  . S CNT=CNT+1
  1.  . I PATS?1U1UN1.14UNP D  Q
  1.  .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
  1.  . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
  1.  Q
  1.  ;
  1. ALLPATS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
  1.  ; uses APATS within this scope
  1.  ; returns all patients that have lab data
  1.  N CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
  1.  ; if item exists in condition, route to other procedure
  1.  I $L(COND) D  Q
  1.  . S OK=0 F TYPE="C","M","A" D  Q:OK  ; use first valid type
  1.  .. I $$CONDOK^LRPXAPIU(COND,TYPE) S OK=1 Q
  1.  . I 'OK Q
  1.  . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
  1.  . I TYPE="C" D PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
  1.  . D PATIENTS^LRPXAPI3(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
  1.  S NMSP=$G(PATS) K PATS S PATS=""
  1.  ; return patients in ^TMP(NMSP,$J
  1.  I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
  1.  D DATES^LRPXAPIU(.DATE1,.DATE2)
  1.  S NEXT=+$G(NEXT)
  1.  S DFN=NEXT
  1.  S CNT=0
  1.  I '$L(SOURCE) D
  1.  . F  S DFN=$O(^PXRMINDX(63,"PI",DFN)) Q:DFN<1  D APATS Q:CNT'<MAX
  1.  E  D
  1.  . F  S DFN=$O(@SOURCE@(DFN)) Q:DFN<1  D APATS Q:CNT'<MAX
  1.  S NEXT=+DFN
  1.  Q
  1. APATS ; within scope of ALLPATS
  1.  S OK=0
  1.  S ITEM=""
  1.  F  S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM=""  D  Q:OK
  1.  . S DATE=DATE1
  1.  . F  S DATE=+$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE<1  D  Q:OK
  1.  .. I DATE>DATE2 Q
  1.  .. S OK=1 Q
  1.  I OK D
  1.  . S CNT=CNT+1
  1.  . I PATS?1U1UN1.14UNP D  Q
  1.  .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
  1.  . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
  1.  Q
  1.  ;
  1. PTS(PATS,TYPE,PITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
  1.  ; uses PCHK within this scope
  1.  ; returns patients who have AP or Micro (all or partial type) results in array PATS
  1.  N CAT,CATONLY,CATSUB,CNT,CONDOK,CONDS,DATE,DFN,DONE,ERR,ITEM
  1.  N ISTOP,NMSP,OK K CONDS
  1.  S NMSP=$G(PATS) K PATS S PATS=""
  1.  ; return all patients in ^TMP(NMSP,$J
  1.  I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
  1.  D DATES^LRPXAPIU(.DATE1,.DATE2)
  1.  S CONDOK=+$P($G(NEXT),U,2)
  1.  S NEXT=+$G(NEXT)
  1.  S DFN=NEXT
  1.  I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
  1.  S CAT="",CATSUB=""
  1.  S CATONLY=$$CATONLY(COND)
  1.  I CATONLY S CAT=$E(COND,$L(COND)-1)
  1.  I $L(CAT) D
  1.  . S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
  1.  . I CATSUB=-1 S CATSUB="" Q
  1.  I $L(COND),'CATONLY D  Q
  1.  . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
  1.  . D PATIENTS(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
  1.  I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
  1.  E  S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
  1.  S CNT=0
  1.  S DONE=0
  1.  S ITEM=PITEM
  1.  F  S ITEM=$O(^PXRMINDX(63,"IP",ITEM)) Q:ITEM=""  Q:ITEM]ISTOP  D  Q:DONE
  1.  . I TYPE'=$E(ITEM) S DONE=1 Q
  1.  . I '$L(SOURCE) D
  1.  .. F  S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1  D PT Q:DONE
  1.  . E  D
  1.  .. F  S DFN=$O(@SOURCE@(DFN)) Q:DFN<1  D  Q:DONE
  1.  ... I $D(^PXRMINDX(63,"IP",ITEM,DFN)) D PT
  1.  S NEXT=+DFN_U_1
  1.  Q
  1. PT ; within scope of PATIENTS
  1.  S OK=0
  1.  S DATE=DATE1
  1.  F  S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1  D  Q:OK
  1.  . I DATE>DATE2 Q
  1.  . I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
  1.  . S OK=1
  1.  I OK D
  1.  . S CNT=CNT+1
  1.  . I CNT'<MAX S DONE=1
  1.  . I PATS?1U1UN1.14UNP D  Q
  1.  .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
  1.  . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
  1.  Q
  1.  ;
  1. CATONLY(COND) ; $$(condition) -> 1 if condition is only a category, else 0
  1.  I '$L(COND) Q 0
  1.  I $L(COND)>6 Q 0
  1.  I $E(COND,$L(COND))'="""" Q 0
  1.  I $E(COND,1,3)["C=" Q 1
  1.  Q 0
  1.  ;
  1. CATOK(DFN,ITEM,DATE,CATSUB) ; $$(dfn,item,date,cat) -> 1 if any nodes match category, else 0
  1.  N NODE,SUB
  1.  S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,""))
  1.  I NODE="" Q 0
  1.  S SUB=$P(NODE,";",2)
  1.  I SUB=CATSUB Q 1
  1.  I SUB="MI",$P(NODE,";",4)=CATSUB Q 1
  1.  I SUB="AY",CATSUB="AU" Q 1
  1.  I SUB=80,CATSUB="AU" Q 1
  1.  I SUB=33,CATSUB="AU" Q 1
  1.  Q 0