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