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