LRPXAPI5 ;VA/SLC/STAFF - Lab Extract API code: Match ;9/30/03 09:59
;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
;
;;VA LR Patche(s): 295
;
MATCH(DFN,DATE,CONDS,TYPE) ; $$(dfn,date,conds,type) -> 1 if ok, else 0
Q:'$$PATCH^BLRUTIL4("PXRM*1.5*12") 0 ; IHS/MSC/MKK - LR*5.2*1031
;
; 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
;
LRPXAPI5 ;VA/SLC/STAFF - Lab Extract API code: Match ;9/30/03 09:59
+1 ;;5.2;LAB SERVICE;**1030,1031**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patche(s): 295
+4 ;
MATCH(DFN,DATE,CONDS,TYPE) ; $$(dfn,date,conds,type) -> 1 if ok, else 0
+1 ; IHS/MSC/MKK - LR*5.2*1031
IF '$$PATCH^BLRUTIL4("PXRM*1.5*12")
QUIT 0
+2 ;
+3 ; from LRPXAPI3,LRPXAPI6
+4 ; check if conditions are met for date/time
+5 IF CONDS="|"
QUIT $$EXACT^LRPXAPI4(DFN,DATE,.CONDS)
+6 NEW FETCH,ITEM,NODE,OK,RESULTS,SEPARATE,SUB,XDATE
KILL FETCH,RESULTS,SEPARATE
+7 SET OK=1
+8 IF '$LENGTH($ORDER(CONDS("")))
QUIT 1
+9 MERGE FETCH=^PXRMINDX(63,"PDI",DFN,DATE)
+10 SET ITEM=""
+11 FOR
SET ITEM=$ORDER(FETCH(ITEM))
IF ITEM=""
QUIT
Begin DoDot:1
+12 IF $EXTRACT(ITEM)'=TYPE
SET OK=0
QUIT
+13 SET NODE=""
+14 FOR
SET NODE=$ORDER(FETCH(ITEM,NODE))
IF NODE=""
QUIT
Begin DoDot:2
+15 SET SUB=$PIECE(NODE,";",2)
+16 IF '(SUB="AU"!(SUB="AY")!(SUB=33)!(SUB=80))
Begin DoDot:3
+17 SET SEPARATE($PIECE(NODE,";",1,3),ITEM,NODE)=""
End DoDot:3
+18 IF '$TEST
SET SEPARATE(DATE,ITEM,NODE)=""
End DoDot:2
End DoDot:1
IF 'OK
QUIT
+19 IF 'OK
QUIT 0
+20 SET XDATE=""
+21 FOR
SET XDATE=$ORDER(SEPARATE(XDATE))
IF XDATE=""
QUIT
Begin DoDot:1
+22 KILL RESULTS
+23 MERGE RESULTS=SEPARATE(XDATE)
+24 IF '$LENGTH($ORDER(RESULTS("")))
SET OK=0
QUIT
+25 IF $DATA(CONDS(0))
DO NOTEQUAL(.CONDS,.RESULTS,.OK)
IF 'OK
QUIT
+26 IF $DATA(CONDS(1))
DO EQUAL(.CONDS,.RESULTS,.OK)
IF 'OK
QUIT
+27 IF $DATA(CONDS("AC"))
DO AC(.CONDS,.RESULTS,.OK)
IF 'OK
QUIT
+28 IF $DATA(CONDS("MC"))
DO MC(.CONDS,.RESULTS,.OK)
IF 'OK
QUIT
+29 IF $DATA(CONDS("AS"))
DO AS(.CONDS,.RESULTS,.OK)
IF 'OK
QUIT
+30 IF $DATA(CONDS("MIR"))
DO MIR(.CONDS,.RESULTS,.OK)
IF 'OK
QUIT
End DoDot:1
IF OK
QUIT
+31 QUIT OK
+32 ;
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 ;
