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

LRPXAPI6.m

Go to the documentation of this file.
  1. LRPXAPI6 ;SLC/STAFF Lab Extract API code ;10/5/03 14:53
  1. ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
  1. ;
  1. CONDS(CONDS,COND,TYPE,ITEM) ; from LRPXAPI3
  1. ; returns array CONDS of conditions - for Micro and AP
  1. ; used to determine match, XCONDS determines exact match
  1. I COND["|" D XCONDS(.CONDS,COND,TYPE,$G(ITEM)) Q
  1. N EQUAL,ITEMCHAR,NOTEQUAL,NUM,PIECE
  1. K CONDS
  1. I $E(COND)="~" S COND=$E(COND,2,245)
  1. S ITEM=$G(ITEM)
  1. I $L(ITEM) S COND=COND_"~"_$P(ITEM,";",2)_"="_$P(ITEM,";",3)
  1. S NUM=1
  1. F S PIECE=$P(COND,"~",NUM) Q:PIECE="" D
  1. . S NUM=NUM+1
  1. . S ITEMCHAR=$E(PIECE)
  1. . I ITEMCHAR="S",TYPE="A" D Q
  1. .. S CONDS("AS",PIECE)=""
  1. . I ITEMCHAR="I",TYPE="M" D Q
  1. .. S CONDS("MIR",PIECE)=""
  1. . I ITEMCHAR="R",TYPE="M" D Q
  1. .. S CONDS("MIR",PIECE)=""
  1. . I ITEMCHAR="C" D Q
  1. .. S CONDS(TYPE_"C",PIECE)=""
  1. . S NOTEQUAL=+$P(PIECE,"'=",2)
  1. . I NOTEQUAL S CONDS(0,TYPE_";"_ITEMCHAR_";"_NOTEQUAL)="" Q
  1. . S EQUAL=+$P(PIECE,"=",2)
  1. . I EQUAL S CONDS(1,TYPE_";"_ITEMCHAR_";"_EQUAL)="" Q
  1. S CONDS="~"
  1. Q
  1. ;
  1. XCONDS(CONDS,COND,TYPE,ITEM) ;
  1. ; returns array CONDS of conditions - for Micro and AP
  1. ; used to determine exact match
  1. N EQUAL,ITEMCHAR,NOTEQUAL,NUM,PIECE
  1. K CONDS
  1. I $E(COND)="|" S COND=$E(COND,2,245)
  1. S ITEM=$G(ITEM)
  1. I $L(ITEM) S COND=COND_"|"_$P(ITEM,";",2)_"="_$P(ITEM,";",3)
  1. S NUM=1
  1. F S PIECE=$P(COND,"|",NUM) Q:PIECE="" D
  1. . S NUM=NUM+1
  1. . S ITEMCHAR=$E(PIECE)
  1. . I ITEMCHAR="S",TYPE="A" D Q
  1. .. S CONDS("AS",PIECE)=""
  1. .. S CONDS("X","A;S")=""
  1. . I ITEMCHAR="I",TYPE="M" D Q
  1. .. S CONDS("MIR",PIECE)=""
  1. .. S CONDS("X","MIR","I")=""
  1. . I ITEMCHAR="R",TYPE="M" D Q
  1. .. S CONDS("MIR",PIECE)=""
  1. .. S CONDS("X","MIR","R")=""
  1. . I ITEMCHAR="C" D Q
  1. .. S CONDS(TYPE_"C",PIECE)=""
  1. .. S CONDS("X",TYPE_";C")=""
  1. . S NOTEQUAL=+$P(PIECE,"'=",2)
  1. . I NOTEQUAL D Q
  1. .. S CONDS(0,TYPE_";"_ITEMCHAR_";"_NOTEQUAL)=""
  1. .. S CONDS("X",TYPE_";"_ITEMCHAR)=""
  1. . S EQUAL=+$P(PIECE,"=",2)
  1. . I EQUAL D Q
  1. .. S CONDS(1,TYPE_";"_ITEMCHAR_";"_EQUAL)=""
  1. .. S CONDS("X",TYPE_";"_ITEMCHAR)=""
  1. . S CONDS("X",TYPE)=""
  1. S CONDS="|"
  1. I NUM=2 S CONDS="~"
  1. Q
  1. ;
  1. ITEM(ITEM,TYPE,COND,ERR) ; from LRPXAPI1
  1. ; return an item from condition
  1. N DEL,ITEMCHAR,NUM,PIECE
  1. S ERR=1,ITEM=""
  1. I TYPE="C" Q
  1. I COND["|" S DEL="|"
  1. E S DEL="~"
  1. S NUM=1
  1. F S PIECE=$P(COND,DEL,NUM) Q:PIECE="" D Q:$L(ITEM)
  1. . S NUM=NUM+1
  1. . S ITEMCHAR=$E(PIECE)
  1. . I $E(PIECE,2)'="=" Q
  1. . I ITEMCHAR="C" Q
  1. . I ITEMCHAR="R" Q
  1. . I ITEMCHAR="I",TYPE="M" Q
  1. . I ITEMCHAR="S",TYPE="A" S ITEM="A;S;1."_$P(PIECE,"=",2) Q
  1. . S ITEM=TYPE_";"_ITEMCHAR_";"_$P(PIECE,"=",2) Q
  1. I $L(ITEM) S ERR=0
  1. Q
  1. ;
  1. CHECK(VAR,COND,VALUE) ; $$(variable,condition,value) -> 1 or 0
  1. S @VAR=VALUE
  1. X COND
  1. Q $T
  1. ;
  1. TEST ; *** used for testing only
  1. F D T
  1. Q
  1. T N TYPE,ERR,COND,CONDS K CONDS
  1. ;D GETTYPE^LRPXAPPU(.TYPE,.ERR) I ERR Q
  1. D GETCOND^LRPXAPPU(.COND,"A",.ERR) I ERR Q
  1. D CONDS(.CONDS,COND,"A")
  1. ;W ! ZW CONDS
  1. ;I $$MATCH^LRPXAPI5(2,2950206.1116,.CONDS) W !,"YES",! Q
  1. ;I $$MATCH^LRPXAPI5(14,2980910.100232,.CONDS) W !,"YES",! Q
  1. I $$MATCH^LRPXAPI5(16,2960503,.CONDS) W !,"YES",! Q
  1. W !,"NO",!
  1. Q