- LRPXAPI5 ;SLC/STAFF Lab Extract API code - Match ;9/30/03 09:59
- ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
- ;
- MATCH(DFN,DATE,CONDS,TYPE) ; $$(dfn,date,conds,type) -> 1 if ok, else 0
- ; from LRPXAPI3,LRPXAPI6
- ; check if conditions are met for date/time
- I CONDS="|" Q $$EXACT^LRPXAPI4(DFN,DATE,.CONDS)
- N FETCH,ITEM,NODE,OK,RESULTS,SEPARATE,SUB,XDATE K FETCH,RESULTS,SEPARATE
- S OK=1
- I '$L($O(CONDS(""))) Q 1
- M FETCH=^PXRMINDX(63,"PDI",DFN,DATE)
- S ITEM=""
- F S ITEM=$O(FETCH(ITEM)) Q:ITEM="" D Q:'OK
- . I $E(ITEM)'=TYPE S OK=0 Q
- . S NODE=""
- . F S NODE=$O(FETCH(ITEM,NODE)) Q:NODE="" D
- .. S SUB=$P(NODE,";",2)
- .. I '(SUB="AU"!(SUB="AY")!(SUB=33)!(SUB=80)) D
- ... S SEPARATE($P(NODE,";",1,3),ITEM,NODE)=""
- .. E S SEPARATE(DATE,ITEM,NODE)=""
- I 'OK Q 0
- S XDATE=""
- F S XDATE=$O(SEPARATE(XDATE)) Q:XDATE="" D Q:OK
- . K RESULTS
- . M RESULTS=SEPARATE(XDATE)
- . I '$L($O(RESULTS(""))) S OK=0 Q
- . I $D(CONDS(0)) D NOTEQUAL(.CONDS,.RESULTS,.OK) I 'OK Q
- . I $D(CONDS(1)) D EQUAL(.CONDS,.RESULTS,.OK) I 'OK Q
- . I $D(CONDS("AC")) D AC(.CONDS,.RESULTS,.OK) I 'OK Q
- . I $D(CONDS("MC")) D MC(.CONDS,.RESULTS,.OK) I 'OK Q
- . I $D(CONDS("AS")) D AS(.CONDS,.RESULTS,.OK) I 'OK Q
- . I $D(CONDS("MIR")) D MIR(.CONDS,.RESULTS,.OK) I 'OK Q
- Q OK
- ;
- NOTEQUAL(CONDS,RESULTS,OK) ;
- ; check not equal condition for pointer values
- N ITEM,ITEM1
- S OK=1
- S ITEM=""
- F S ITEM=$O(CONDS(0,ITEM)) Q:ITEM="" D I 'OK Q
- . I $D(RESULTS(ITEM)) S OK=0 Q
- . S ITEM1=$O(RESULTS($P(ITEM,";",1,2)))
- . I $P(ITEM1,";",1,2)'=$P(ITEM,";",1,2) S OK=0 Q
- Q
- ;
- EQUAL(CONDS,RESULTS,OK) ;
- ; check equal condition for pointer values
- N ITEM
- S OK=1
- S ITEM=""
- F S ITEM=$O(CONDS(1,ITEM)) Q:ITEM="" D I 'OK Q
- . I '$D(RESULTS(ITEM)) S OK=0 Q
- Q
- ;
- AC(CONDS,RESULTS,OK) ;
- ; check conditions for AP categories
- N CAT,CATEGORY,ITEM,ITEMC,NEXT,NODE,NOTEQUAL,SUB
- S OK=1
- S ITEM=""
- F S ITEM=$O(CONDS("AC",ITEM)) Q:ITEM="" D
- . S CATEGORY=$P(ITEM,"=",2)
- . I '$L(CATEGORY) Q
- . S CATEGORY=$E(CATEGORY,2)
- . S NOTEQUAL=0
- . I $L($P(ITEM,"'=",2)) S NOTEQUAL=1
- . S ITEMC="A"
- . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;Z" D
- .. I ITEMC["A;T;" Q
- .. S NODE=""
- .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
- ... S SUB=$P(NODE,";",2)
- ... I SUB=33!(SUB=80) S CAT="A"
- ... E S CAT=$E(SUB)
- ... I NOTEQUAL,CAT=CATEGORY K RESULTS
- ... I 'NOTEQUAL,CAT'=CATEGORY K RESULTS(ITEMC,NODE) Q
- S NEXT=$O(RESULTS("A"))
- I NEXT="" S OK=0 Q
- I NEXT]"A;S" S OK=0 Q
- Q
- ;
- MC(CONDS,RESULTS,OK) ;
- ; check conditions for Micro categories
- N CATEGORY,CATSUB,ITEM,ITEMC,NEXT,NODE,NOTEQUAL,SUB
- S OK=1
- S ITEM=""
- F S ITEM=$O(CONDS("MC",ITEM)) Q:ITEM="" D
- . S CATEGORY=$P(ITEM,"=",2)
- . I '$L(CATEGORY) Q
- . S CATEGORY=$E(CATEGORY,2)
- . S CATSUB=$$CATSUB^LRPXAPIU(CATEGORY,"M")
- . S NOTEQUAL=0
- . I $L($P(ITEM,"'=",2)) S NOTEQUAL=1
- . S ITEMC="M"
- . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"M;Z" D
- .. I ITEMC["M;T;" Q
- .. I ITEMC["M;S;" Q
- .. S NODE=""
- .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D
- ... S SUB=$P(NODE,";",4)
- ... I NOTEQUAL,SUB=CATSUB K RESULTS Q
- ... I 'NOTEQUAL,SUB'=CATSUB K RESULTS(ITEMC,NODE) Q
- S NEXT=$O(RESULTS("M"))
- I NEXT="" S OK=0 Q
- I NEXT]"M;S" S OK=0 Q
- Q
- ;
- AS(CONDS,RESULTS,OK) ;
- ; check conditions for AP specimen
- N CHECK,ITEM,ITEMC,S
- S OK=1
- S ITEM=""
- F S ITEM=$O(CONDS("AS",ITEM)) Q:ITEM="" D I OK Q
- . I $E(ITEM,2)="'" D Q
- .. ; good if the specimen text is not present for this collection
- .. S ITEMC="A;S;1"
- .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;S;Z" D Q:OK
- ... S OK=0
- ... S S=$P(ITEMC,"1.",2)
- ... S CHECK="I "_ITEM
- ... X CHECK I $T S OK=1
- . ; good if any of the specimen text for this collection have a matching text
- . I $O(RESULTS("A;S;1"))="" Q
- . I $O(RESULTS("A"))]"A;S;Z" Q
- . S OK=0
- . S ITEMC="A;S;1"
- . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]"A;S;Z" D Q:OK
- .. S S=$P(ITEMC,"1.",2)
- .. S CHECK="I "_ITEM
- .. X CHECK I $T S OK=1
- Q
- ;
- MIR(CONDS,RESULTS,OK) ; $$(dfn,date,conds) -> 1 if ok, else 0
- ; check conditions for antimicrobial results and interpretations
- N ABNODE,CHECK,I,ITEM,ITEMC,ITEMZ,NODE,R
- S OK=1
- ; check bacterial antimicrobials
- S ITEM=""
- F S ITEM=$O(CONDS("MIR",ITEM)) Q:ITEM="" D I 'OK Q
- . I $E(ITEM,2)="'" D Q
- .. ; good if the interpretation/result is not present for this collection
- .. S ITEMC="M;A"
- .. S ITEMZ="M;A;Z"
- .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:'OK
- ... S NODE=""
- ... F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:'OK
- .... S ABNODE=$$REFVAL^LRPXAPI(NODE)
- .... S I=$P(ABNODE,U,2)
- .... S R=$P(ABNODE,U)
- .... S CHECK="I "_ITEM
- .... X CHECK I $T S OK=0
- . ; good if any of the interpretations/results have matching conditions
- . I $O(RESULTS("M;A"))="" Q
- . I $O(RESULTS("M;A"))]"M;A;Z" Q
- . S OK=0
- . S ITEMC="M;A"
- . S ITEMZ="M;A;Z"
- . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:OK
- .. S NODE=""
- .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:OK
- ... S ABNODE=$$REFVAL^LRPXAPI(NODE)
- ... S I=$P(ABNODE,U,2)
- ... S R=$P(ABNODE,U)
- ... S CHECK="I "_ITEM
- ... X CHECK I $T S OK=1
- ; check mycobacterial antimicrobials
- F S ITEM=$O(CONDS("MIR",ITEM)) Q:ITEM="" D I 'OK Q
- . I $E(ITEM,2)="'" D Q
- .. ; good if the interpretation/result is not present for this collection
- .. S ITEMC="M;M"
- .. S ITEMZ="M;M;Z"
- .. F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:'OK
- ... S NODE=""
- ... F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:'OK
- .... S ABNODE=$$REFVAL^LRPXAPI(NODE)
- .... S R=$P(ABNODE,U)
- .... S I=R
- .... S CHECK="I "_ITEM
- .... X CHECK I $T S OK=0
- . ; good if any of the interpretations/results have matching conditions
- . I $O(RESULTS("M;M"))="" Q
- . I $O(RESULTS("M;M"))]"M;M;Z" Q
- . S OK=0
- . S ITEMC="M;M"
- . S ITEMZ="M;M;Z"
- . F S ITEMC=$O(RESULTS(ITEMC)) Q:ITEMC="" Q:ITEMC]ITEMZ D Q:OK
- .. S NODE=""
- .. F S NODE=$O(RESULTS(ITEMC,NODE)) Q:NODE="" D Q:OK
- ... S ABNODE=$$REFVAL^LRPXAPI(NODE)
- ... S R=$P(ABNODE,U)
- ... S I=R
- ... S CHECK="I "_ITEM
- ... X CHECK I $T S OK=1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXAPI5 6203 printed Feb 18, 2025@23:45:25 Page 2
- LRPXAPI5 ;SLC/STAFF Lab Extract API code - Match ;9/30/03 09:59
- +1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
- +2 ;
- MATCH(DFN,DATE,CONDS,TYPE) ; $$(dfn,date,conds,type) -> 1 if ok, else 0
- +1 ; from LRPXAPI3,LRPXAPI6
- +2 ; check if conditions are met for date/time
- +3 IF CONDS="|"
- QUIT $$EXACT^LRPXAPI4(DFN,DATE,.CONDS)
- +4 NEW FETCH,ITEM,NODE,OK,RESULTS,SEPARATE,SUB,XDATE
- KILL FETCH,RESULTS,SEPARATE
- +5 SET OK=1
- +6 IF '$LENGTH($ORDER(CONDS("")))
- QUIT 1
- +7 MERGE FETCH=^PXRMINDX(63,"PDI",DFN,DATE)
- +8 SET ITEM=""
- +9 FOR
- SET ITEM=$ORDER(FETCH(ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +10 IF $EXTRACT(ITEM)'=TYPE
- SET OK=0
- QUIT
- +11 SET NODE=""
- +12 FOR
- SET NODE=$ORDER(FETCH(ITEM,NODE))
- if NODE=""
- QUIT
- Begin DoDot:2
- +13 SET SUB=$PIECE(NODE,";",2)
- +14 IF '(SUB="AU"!(SUB="AY")!(SUB=33)!(SUB=80))
- Begin DoDot:3
- +15 SET SEPARATE($PIECE(NODE,";",1,3),ITEM,NODE)=""
- End DoDot:3
- +16 IF '$TEST
- SET SEPARATE(DATE,ITEM,NODE)=""
- End DoDot:2
- End DoDot:1
- if 'OK
- QUIT
- +17 IF 'OK
- QUIT 0
- +18 SET XDATE=""
- +19 FOR
- SET XDATE=$ORDER(SEPARATE(XDATE))
- if XDATE=""
- QUIT
- Begin DoDot:1
- +20 KILL RESULTS
- +21 MERGE RESULTS=SEPARATE(XDATE)
- +22 IF '$LENGTH($ORDER(RESULTS("")))
- SET OK=0
- QUIT
- +23 IF $DATA(CONDS(0))
- DO NOTEQUAL(.CONDS,.RESULTS,.OK)
- IF 'OK
- QUIT
- +24 IF $DATA(CONDS(1))
- DO EQUAL(.CONDS,.RESULTS,.OK)
- IF 'OK
- QUIT
- +25 IF $DATA(CONDS("AC"))
- DO AC(.CONDS,.RESULTS,.OK)
- IF 'OK
- QUIT
- +26 IF $DATA(CONDS("MC"))
- DO MC(.CONDS,.RESULTS,.OK)
- IF 'OK
- QUIT
- +27 IF $DATA(CONDS("AS"))
- DO AS(.CONDS,.RESULTS,.OK)
- IF 'OK
- QUIT
- +28 IF $DATA(CONDS("MIR"))
- DO MIR(.CONDS,.RESULTS,.OK)
- IF 'OK
- QUIT
- End DoDot:1
- if OK
- QUIT
- +29 QUIT OK
- +30 ;
- NOTEQUAL(CONDS,RESULTS,OK) ;
- +1 ; check not equal condition for pointer values
- +2 NEW ITEM,ITEM1
- +3 SET OK=1
- +4 SET ITEM=""
- +5 FOR
- SET ITEM=$ORDER(CONDS(0,ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +6 IF $DATA(RESULTS(ITEM))
- SET OK=0
- QUIT
- +7 SET ITEM1=$ORDER(RESULTS($PIECE(ITEM,";",1,2)))
- +8 IF $PIECE(ITEM1,";",1,2)'=$PIECE(ITEM,";",1,2)
- SET OK=0
- QUIT
- End DoDot:1
- IF 'OK
- QUIT
- +9 QUIT
- +10 ;
- EQUAL(CONDS,RESULTS,OK) ;
- +1 ; check equal condition for pointer values
- +2 NEW ITEM
- +3 SET OK=1
- +4 SET ITEM=""
- +5 FOR
- SET ITEM=$ORDER(CONDS(1,ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +6 IF '$DATA(RESULTS(ITEM))
- SET OK=0
- QUIT
- End DoDot:1
- IF 'OK
- QUIT
- +7 QUIT
- +8 ;
- AC(CONDS,RESULTS,OK) ;
- +1 ; check conditions for AP categories
- +2 NEW CAT,CATEGORY,ITEM,ITEMC,NEXT,NODE,NOTEQUAL,SUB
- +3 SET OK=1
- +4 SET ITEM=""
- +5 FOR
- SET ITEM=$ORDER(CONDS("AC",ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +6 SET CATEGORY=$PIECE(ITEM,"=",2)
- +7 IF '$LENGTH(CATEGORY)
- QUIT
- +8 SET CATEGORY=$EXTRACT(CATEGORY,2)
- +9 SET NOTEQUAL=0
- +10 IF $LENGTH($PIECE(ITEM,"'=",2))
- SET NOTEQUAL=1
- +11 SET ITEMC="A"
- +12 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]"A;Z"
- QUIT
- Begin DoDot:2
- +13 IF ITEMC["A;T;"
- QUIT
- +14 SET NODE=""
- +15 FOR
- SET NODE=$ORDER(RESULTS(ITEMC,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +16 SET SUB=$PIECE(NODE,";",2)
- +17 IF SUB=33!(SUB=80)
- SET CAT="A"
- +18 IF '$TEST
- SET CAT=$EXTRACT(SUB)
- +19 IF NOTEQUAL
- IF CAT=CATEGORY
- KILL RESULTS
- +20 IF 'NOTEQUAL
- IF CAT'=CATEGORY
- KILL RESULTS(ITEMC,NODE)
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 SET NEXT=$ORDER(RESULTS("A"))
- +22 IF NEXT=""
- SET OK=0
- QUIT
- +23 IF NEXT]"A;S"
- SET OK=0
- QUIT
- +24 QUIT
- +25 ;
- MC(CONDS,RESULTS,OK) ;
- +1 ; check conditions for Micro categories
- +2 NEW CATEGORY,CATSUB,ITEM,ITEMC,NEXT,NODE,NOTEQUAL,SUB
- +3 SET OK=1
- +4 SET ITEM=""
- +5 FOR
- SET ITEM=$ORDER(CONDS("MC",ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +6 SET CATEGORY=$PIECE(ITEM,"=",2)
- +7 IF '$LENGTH(CATEGORY)
- QUIT
- +8 SET CATEGORY=$EXTRACT(CATEGORY,2)
- +9 SET CATSUB=$$CATSUB^LRPXAPIU(CATEGORY,"M")
- +10 SET NOTEQUAL=0
- +11 IF $LENGTH($PIECE(ITEM,"'=",2))
- SET NOTEQUAL=1
- +12 SET ITEMC="M"
- +13 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]"M;Z"
- QUIT
- Begin DoDot:2
- +14 IF ITEMC["M;T;"
- QUIT
- +15 IF ITEMC["M;S;"
- QUIT
- +16 SET NODE=""
- +17 FOR
- SET NODE=$ORDER(RESULTS(ITEMC,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +18 SET SUB=$PIECE(NODE,";",4)
- +19 IF NOTEQUAL
- IF SUB=CATSUB
- KILL RESULTS
- QUIT
- +20 IF 'NOTEQUAL
- IF SUB'=CATSUB
- KILL RESULTS(ITEMC,NODE)
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 SET NEXT=$ORDER(RESULTS("M"))
- +22 IF NEXT=""
- SET OK=0
- QUIT
- +23 IF NEXT]"M;S"
- SET OK=0
- QUIT
- +24 QUIT
- +25 ;
- AS(CONDS,RESULTS,OK) ;
- +1 ; check conditions for AP specimen
- +2 NEW CHECK,ITEM,ITEMC,S
- +3 SET OK=1
- +4 SET ITEM=""
- +5 FOR
- SET ITEM=$ORDER(CONDS("AS",ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +6 IF $EXTRACT(ITEM,2)="'"
- Begin DoDot:2
- +7 ; good if the specimen text is not present for this collection
- +8 SET ITEMC="A;S;1"
- +9 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]"A;S;Z"
- QUIT
- Begin DoDot:3
- +10 SET OK=0
- +11 SET S=$PIECE(ITEMC,"1.",2)
- +12 SET CHECK="I "_ITEM
- +13 XECUTE CHECK
- IF $TEST
- SET OK=1
- End DoDot:3
- if OK
- QUIT
- End DoDot:2
- QUIT
- +14 ; good if any of the specimen text for this collection have a matching text
- +15 IF $ORDER(RESULTS("A;S;1"))=""
- QUIT
- +16 IF $ORDER(RESULTS("A"))]"A;S;Z"
- QUIT
- +17 SET OK=0
- +18 SET ITEMC="A;S;1"
- +19 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]"A;S;Z"
- QUIT
- Begin DoDot:2
- +20 SET S=$PIECE(ITEMC,"1.",2)
- +21 SET CHECK="I "_ITEM
- +22 XECUTE CHECK
- IF $TEST
- SET OK=1
- End DoDot:2
- if OK
- QUIT
- End DoDot:1
- IF OK
- QUIT
- +23 QUIT
- +24 ;
- MIR(CONDS,RESULTS,OK) ; $$(dfn,date,conds) -> 1 if ok, else 0
- +1 ; check conditions for antimicrobial results and interpretations
- +2 NEW ABNODE,CHECK,I,ITEM,ITEMC,ITEMZ,NODE,R
- +3 SET OK=1
- +4 ; check bacterial antimicrobials
- +5 SET ITEM=""
- +6 FOR
- SET ITEM=$ORDER(CONDS("MIR",ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +7 IF $EXTRACT(ITEM,2)="'"
- Begin DoDot:2
- +8 ; good if the interpretation/result is not present for this collection
- +9 SET ITEMC="M;A"
- +10 SET ITEMZ="M;A;Z"
- +11 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]ITEMZ
- QUIT
- Begin DoDot:3
- +12 SET NODE=""
- +13 FOR
- SET NODE=$ORDER(RESULTS(ITEMC,NODE))
- if NODE=""
- QUIT
- Begin DoDot:4
- +14 SET ABNODE=$$REFVAL^LRPXAPI(NODE)
- +15 SET I=$PIECE(ABNODE,U,2)
- +16 SET R=$PIECE(ABNODE,U)
- +17 SET CHECK="I "_ITEM
- +18 XECUTE CHECK
- IF $TEST
- SET OK=0
- End DoDot:4
- if 'OK
- QUIT
- End DoDot:3
- if 'OK
- QUIT
- End DoDot:2
- QUIT
- +19 ; good if any of the interpretations/results have matching conditions
- +20 IF $ORDER(RESULTS("M;A"))=""
- QUIT
- +21 IF $ORDER(RESULTS("M;A"))]"M;A;Z"
- QUIT
- +22 SET OK=0
- +23 SET ITEMC="M;A"
- +24 SET ITEMZ="M;A;Z"
- +25 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]ITEMZ
- QUIT
- Begin DoDot:2
- +26 SET NODE=""
- +27 FOR
- SET NODE=$ORDER(RESULTS(ITEMC,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +28 SET ABNODE=$$REFVAL^LRPXAPI(NODE)
- +29 SET I=$PIECE(ABNODE,U,2)
- +30 SET R=$PIECE(ABNODE,U)
- +31 SET CHECK="I "_ITEM
- +32 XECUTE CHECK
- IF $TEST
- SET OK=1
- End DoDot:3
- if OK
- QUIT
- End DoDot:2
- if OK
- QUIT
- End DoDot:1
- IF 'OK
- QUIT
- +33 ; check mycobacterial antimicrobials
- +34 FOR
- SET ITEM=$ORDER(CONDS("MIR",ITEM))
- if ITEM=""
- QUIT
- Begin DoDot:1
- +35 IF $EXTRACT(ITEM,2)="'"
- Begin DoDot:2
- +36 ; good if the interpretation/result is not present for this collection
- +37 SET ITEMC="M;M"
- +38 SET ITEMZ="M;M;Z"
- +39 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]ITEMZ
- QUIT
- Begin DoDot:3
- +40 SET NODE=""
- +41 FOR
- SET NODE=$ORDER(RESULTS(ITEMC,NODE))
- if NODE=""
- QUIT
- Begin DoDot:4
- +42 SET ABNODE=$$REFVAL^LRPXAPI(NODE)
- +43 SET R=$PIECE(ABNODE,U)
- +44 SET I=R
- +45 SET CHECK="I "_ITEM
- +46 XECUTE CHECK
- IF $TEST
- SET OK=0
- End DoDot:4
- if 'OK
- QUIT
- End DoDot:3
- if 'OK
- QUIT
- End DoDot:2
- QUIT
- +47 ; good if any of the interpretations/results have matching conditions
- +48 IF $ORDER(RESULTS("M;M"))=""
- QUIT
- +49 IF $ORDER(RESULTS("M;M"))]"M;M;Z"
- QUIT
- +50 SET OK=0
- +51 SET ITEMC="M;M"
- +52 SET ITEMZ="M;M;Z"
- +53 FOR
- SET ITEMC=$ORDER(RESULTS(ITEMC))
- if ITEMC=""
- QUIT
- if ITEMC]ITEMZ
- QUIT
- Begin DoDot:2
- +54 SET NODE=""
- +55 FOR
- SET NODE=$ORDER(RESULTS(ITEMC,NODE))
- if NODE=""
- QUIT
- Begin DoDot:3
- +56 SET ABNODE=$$REFVAL^LRPXAPI(NODE)
- +57 SET R=$PIECE(ABNODE,U)
- +58 SET I=R
- +59 SET CHECK="I "_ITEM
- +60 XECUTE CHECK
- IF $TEST
- SET OK=1
- End DoDot:3
- if OK
- QUIT
- End DoDot:2
- if OK
- QUIT
- End DoDot:1
- IF 'OK
- QUIT
- +61 QUIT
- +62 ;
