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

LRPXAPI5.m

Go to the documentation of this file.
  1. LRPXAPI5 ;SLC/STAFF Lab Extract API code - Match ;9/30/03 09:59
  1. ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
  1. ;
  1. MATCH(DFN,DATE,CONDS,TYPE) ; $$(dfn,date,conds,type) -> 1 if ok, else 0
  1. ; from LRPXAPI3,LRPXAPI6
  1. ; check if conditions are met for date/time
  1. I CONDS="|" Q $$EXACT^LRPXAPI4(DFN,DATE,.CONDS)
  1. N FETCH,ITEM,NODE,OK,RESULTS,SEPARATE,SUB,XDATE K FETCH,RESULTS,SEPARATE
  1. S OK=1
  1. I '$L($O(CONDS(""))) Q 1
  1. M FETCH=^PXRMINDX(63,"PDI",DFN,DATE)
  1. S ITEM=""
  1. F S ITEM=$O(FETCH(ITEM)) Q:ITEM="" D Q:'OK
  1. . I $E(ITEM)'=TYPE S OK=0 Q
  1. . S NODE=""
  1. . F S NODE=$O(FETCH(ITEM,NODE)) Q:NODE="" D
  1. .. S SUB=$P(NODE,";",2)
  1. .. I '(SUB="AU"!(SUB="AY")!(SUB=33)!(SUB=80)) D
  1. ... S SEPARATE($P(NODE,";",1,3),ITEM,NODE)=""
  1. .. E S SEPARATE(DATE,ITEM,NODE)=""
  1. I 'OK Q 0
  1. S XDATE=""
  1. F S XDATE=$O(SEPARATE(XDATE)) Q:XDATE="" D Q:OK
  1. . K RESULTS
  1. . M RESULTS=SEPARATE(XDATE)
  1. . I '$L($O(RESULTS(""))) S OK=0 Q
  1. . I $D(CONDS(0)) D NOTEQUAL(.CONDS,.RESULTS,.OK) I 'OK Q
  1. . I $D(CONDS(1)) D EQUAL(.CONDS,.RESULTS,.OK) I 'OK Q
  1. . I $D(CONDS("AC")) D AC(.CONDS,.RESULTS,.OK) I 'OK Q
  1. . I $D(CONDS("MC")) D MC(.CONDS,.RESULTS,.OK) I 'OK Q
  1. . I $D(CONDS("AS")) D AS(.CONDS,.RESULTS,.OK) I 'OK Q
  1. . I $D(CONDS("MIR")) D MIR(.CONDS,.RESULTS,.OK) I 'OK Q
  1. Q OK
  1. ;
  1. NOTEQUAL(CONDS,RESULTS,OK) ;
  1. ; check not equal condition for pointer values
  1. N ITEM,ITEM1
  1. S OK=1
  1. S ITEM=""
  1. F S ITEM=$O(CONDS(0,ITEM)) Q:ITEM="" D I 'OK Q
  1. . I $D(RESULTS(ITEM)) S OK=0 Q
  1. . S ITEM1=$O(RESULTS($P(ITEM,";",1,2)))
  1. . I $P(ITEM1,";",1,2)'=$P(ITEM,";",1,2) S OK=0 Q
  1. Q
  1. ;
  1. EQUAL(CONDS,RESULTS,OK) ;
  1. ; check equal condition for pointer values
  1. N ITEM
  1. S OK=1
  1. S ITEM=""
  1. F S ITEM=$O(CONDS(1,ITEM)) Q:ITEM="" D I 'OK Q
  1. . I '$D(RESULTS(ITEM)) S OK=0 Q
  1. Q
  1. ;
  1. AC(CONDS,RESULTS,OK) ;
  1. ; check conditions for AP categories
  1. N CAT,CATEGORY,ITEM,ITEMC,NEXT,NODE,NOTEQUAL,SUB
  1. S OK=1
  1. S ITEM=""
  1. F S ITEM=$O(CONDS("AC",ITEM)) Q:ITEM="" D
  1. . S CATEGORY=$P(ITEM,"=",2)
  1. . I '$L(CATEGORY) Q
  1. . S CATEGORY=$E(CATEGORY,2)
  1. . S NOTEQUAL=0
  1. . I $L($P(ITEM,"'=",2)) S NOTEQUAL=1
  1. . S ITEMC="A"
  1. . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;Z" D
  1. .. I ITEMC["A;T;" Q
  1. .. S NODE=""
  1. .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
  1. ... S SUB=$P(NODE,";",2)
  1. ... I SUB=33!(SUB=80) S CAT="A"
  1. ... E S CAT=$E(SUB)
  1. ... I NOTEQUAL,CAT=CATEGORY K RESULTS
  1. ... I 'NOTEQUAL,CAT'=CATEGORY K RESULTS(ITEMC,NODE) Q
  1. S NEXT=$O(RESULTS("A"))
  1. I NEXT="" S OK=0 Q
  1. I NEXT]"A;S" S OK=0 Q
  1. Q
  1. ;
  1. MC(CONDS,RESULTS,OK) ;
  1. ; check conditions for Micro categories
  1. N CATEGORY,CATSUB,ITEM,ITEMC,NEXT,NODE,NOTEQUAL,SUB
  1. S OK=1
  1. S ITEM=""
  1. F S ITEM=$O(CONDS("MC",ITEM)) Q:ITEM="" D
  1. . S CATEGORY=$P(ITEM,"=",2)
  1. . I '$L(CATEGORY) Q
  1. . S CATEGORY=$E(CATEGORY,2)
  1. . S CATSUB=$$CATSUB^LRPXAPIU(CATEGORY,"M")
  1. . S NOTEQUAL=0
  1. . I $L($P(ITEM,"'=",2)) S NOTEQUAL=1
  1. . S ITEMC="M"
  1. . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"M;Z" D
  1. .. I ITEMC["M;T;" Q
  1. .. I ITEMC["M;S;" Q
  1. .. S NODE=""
  1. .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
  1. ... S SUB=$P(NODE,";",4)
  1. ... I NOTEQUAL,SUB=CATSUB K RESULTS Q
  1. ... I 'NOTEQUAL,SUB'=CATSUB K RESULTS(ITEMC,NODE) Q
  1. S NEXT=$O(RESULTS("M"))
  1. I NEXT="" S OK=0 Q
  1. I NEXT]"M;S" S OK=0 Q
  1. Q
  1. ;
  1. AS(CONDS,RESULTS,OK) ;
  1. ; check conditions for AP specimen
  1. N CHECK,ITEM,ITEMC,S
  1. S OK=1
  1. S ITEM=""
  1. F S ITEM=$O(CONDS("AS",ITEM)) Q:ITEM="" D I OK Q
  1. . I $E(ITEM,2)="'" D Q
  1. .. ; good if the specimen text is not present for this collection
  1. .. S ITEMC="A;S;1"
  1. .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;S;Z" D Q:OK
  1. ... S OK=0
  1. ... S S=$P(ITEMC,"1.",2)
  1. ... S CHECK="I "_ITEM
  1. ... X CHECK I $T S OK=1
  1. . ; good if any of the specimen text for this collection have a matching text
  1. . I $O(RESULTS("A;S;1"))="" Q
  1. . I $O(RESULTS("A"))]"A;S;Z" Q
  1. . S OK=0
  1. . S ITEMC="A;S;1"
  1. . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;S;Z" D Q:OK
  1. .. S S=$P(ITEMC,"1.",2)
  1. .. S CHECK="I "_ITEM
  1. .. X CHECK I $T S OK=1
  1. Q
  1. ;
  1. MIR(CONDS,RESULTS,OK) ; $$(dfn,date,conds) -> 1 if ok, else 0
  1. ; check conditions for antimicrobial results and interpretations
  1. N ABNODE,CHECK,I,ITEM,ITEMC,ITEMZ,NODE,R
  1. S OK=1
  1. ; check bacterial antimicrobials
  1. S ITEM=""
  1. F S ITEM=$O(CONDS("MIR",ITEM)) Q:ITEM="" D I 'OK Q
  1. . I $E(ITEM,2)="'" D Q
  1. .. ; good if the interpretation/result is not present for this collection
  1. .. S ITEMC="M;A"
  1. .. S ITEMZ="M;A;Z"
  1. .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:'OK
  1. ... S NODE=""
  1. ... F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:'OK
  1. .... S ABNODE=$$REFVAL^LRPXAPI(NODE)
  1. .... S I=$P(ABNODE,U,2)
  1. .... S R=$P(ABNODE,U)
  1. .... S CHECK="I "_ITEM
  1. .... X CHECK I $T S OK=0
  1. . ; good if any of the interpretations/results have matching conditions
  1. . I $O(RESULTS("M;A"))="" Q
  1. . I $O(RESULTS("M;A"))]"M;A;Z" Q
  1. . S OK=0
  1. . S ITEMC="M;A"
  1. . S ITEMZ="M;A;Z"
  1. . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:OK
  1. .. S NODE=""
  1. .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:OK
  1. ... S ABNODE=$$REFVAL^LRPXAPI(NODE)
  1. ... S I=$P(ABNODE,U,2)
  1. ... S R=$P(ABNODE,U)
  1. ... S CHECK="I "_ITEM
  1. ... X CHECK I $T S OK=1
  1. ; check mycobacterial antimicrobials
  1. F S ITEM=$O(CONDS("MIR",ITEM)) Q:ITEM="" D I 'OK Q
  1. . I $E(ITEM,2)="'" D Q
  1. .. ; good if the interpretation/result is not present for this collection
  1. .. S ITEMC="M;M"
  1. .. S ITEMZ="M;M;Z"
  1. .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:'OK
  1. ... S NODE=""
  1. ... F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:'OK
  1. .... S ABNODE=$$REFVAL^LRPXAPI(NODE)
  1. .... S R=$P(ABNODE,U)
  1. .... S I=R
  1. .... S CHECK="I "_ITEM
  1. .... X CHECK I $T S OK=0
  1. . ; good if any of the interpretations/results have matching conditions
  1. . I $O(RESULTS("M;M"))="" Q
  1. . I $O(RESULTS("M;M"))]"M;M;Z" Q
  1. . S OK=0
  1. . S ITEMC="M;M"
  1. . S ITEMZ="M;M;Z"
  1. . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:OK
  1. .. S NODE=""
  1. .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:OK
  1. ... S ABNODE=$$REFVAL^LRPXAPI(NODE)
  1. ... S R=$P(ABNODE,U)
  1. ... S I=R
  1. ... S CHECK="I "_ITEM
  1. ... X CHECK I $T S OK=1
  1. Q
  1. ;