LRPXAPI2 ; SLC/STAFF Lab Extract API code ;2/26/04  15:15
 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
 ;
VERIFIED(LRDFN,LRIDT) ; $$(lrdfn,lridt) -> 1 if verified, else 0
 ; checks for date report completed
 I +$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,3) Q 1
 Q 0
 ;
MIVERIFY(LRDFN,LRIDT,SUB) ; $$(lrdfn,lridt,sub) -> 1 if verified, else 0
 ; checks for report date approved on subscript
 S SUB=+$G(SUB)
 I SUB>0,SUB<17,$G(^LR(LRDFN,"MI",LRIDT,SUB)) Q 1
 Q 0
 ;
APVERIFY(LRDFN,LRIDT,APSUB) ; $$(lrdfn,lridt,ap subscrpt) -> 1 if verified
 ; autopsy checks for:
 ;   date of death, 
 ;   date autopsy report completed,
 ;   autopsy release date/time
 ; otherwise, checks for date report completed and report release date
 N OK
 S OK=0
 I APSUB="CY"!(APSUB="EM")!(APSUB="SP") D  Q OK
 . I $P($G(^LR(LRDFN,APSUB,LRIDT,0)),U,3),$P(^(0),U,11) S OK=1
 I APSUB="AU" D  Q OK
 . I '$$DOD^LRPXAPIU($$DFN^LRPXAPIU(LRDFN)) Q
 . I '$P($G(^LR(LRDFN,"AU")),U,3) Q
 . I '$P(^LR(LRDFN,"AU"),U,15) Q
 . S OK=1
 Q OK
 ;
VAL(LRDFN,LRIDT,LRDN) ; from LRPXAPI
 ; $$(lrdfn,lridt,lrdn) -> result node
 Q $G(^LR(LRDFN,"CH",LRIDT,LRDN))
 ;
REFVAL(REF) ; from LRPXAPI
 ; $$(reference location in ^LR) -> data node
 N SUB
 I REF'[";" Q ""
 S SUB=$P(REF,";",2)
 S SUB=""""_SUB_""""
 S $P(REF,";",2)=SUB
 S REF=$TR(REF,";",",")
 S REF="^LR("_REF_")"
 Q $G(@REF)
 ;
LRPXRM(RESULT,REF,ITEM,TYPES) ; from LRPXAPI
 ; returns result node from index subscript as RESULT
 N FILE,IEN,SECTION,TEST,VALUES
 S RESULT=""
 S VALUES=$$REFVAL(REF)
 I '$L(VALUES) Q
 I ITEM>0 D  Q
 . S $P(VALUES,U)=$$VRESULT^LRPXAPIU(ITEM,$P(VALUES,U))
 . S RESULT=+ITEM_U_$$TESTNM^LRPXAPIU(+ITEM)_U_VALUES
 . D SC(.RESULT,REF,TYPES)
 I '$L(ITEM) D  Q
 . I $P(REF,";",2)'="CH" Q
 . S TEST=$$TEST^LRPXAPIU(+$P(REF,";",4))
 . I 'TEST Q
 . S RESULT=TEST_U_$$TESTNM^LRPXAPIU(TEST)_U_VALUES
 . D SC(.RESULT,REF,TYPES)
 S SECTION=$P(ITEM,";") I $L(SECTION)'=1 Q
 S FILE=$P(ITEM,";",2) I $L(FILE)'=1 Q
 S IEN=+$P(ITEM,";",3) I 'IEN Q
 I SECTION="M" D  Q
 . I FILE="S" S RESULT=IEN_U_$$SPECNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="T" S RESULT=IEN_U_$$TESTNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="O" S RESULT=IEN_U_$$BUGNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="A" S RESULT=IEN_U_$$ABNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="M" S RESULT=IEN_U_$$TBNM^LRPXAPIU(IEN)_U_VALUES Q
 I SECTION="A" D  Q
 . I FILE="S" S RESULT=U_$$UP^XLFSTR(VALUES)_U_VALUES Q
 . I FILE="T" S RESULT=IEN_U_$$TESTNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="O" S RESULT=IEN_U_$$ORGNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="D" S RESULT=IEN_U_$$DISNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="M" S RESULT=IEN_U_$$MORPHNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="E" S RESULT=IEN_U_$$ETINM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="F" S RESULT=IEN_U_$$FUNNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="P" S RESULT=IEN_U_$$PROCNM^LRPXAPIU(IEN)_U_VALUES Q
 . I FILE="I" S RESULT=IEN_U_$$ICD9^LRPXAPIU(IEN)_U_VALUES Q
 Q
 ;
SC(RESULT,REF,TYPES) ;
 N CNT,LINE,LRDFN,LRIDT,SPEC
 I TYPES["S" D
 . S $P(REF,";",4)=0
 . S SPEC=+$P($$REFVAL(REF),U,5)
 . S RESULT("SPECIMEN")=SPEC_U_$$SPECNM^LRPXAPIU(SPEC)
 I TYPES["C" D
 . S CNT=0,LRDFN=+$P(REF,";"),LRIDT=+$P(REF,";",3)
 . S LINE=0
 . F  S LINE=$O(^LR(LRDFN,"CH",LRIDT,1,LINE)) Q:LINE<1  D
 .. S CNT=CNT+1
 .. S RESULT("COMMENTS",CNT)=$G(^LR(LRDFN,"CH",LRIDT,1,LINE,0))
 . S RESULT("COMMENTS")=CNT
 Q
 ;
SPEC(DATA,DFN,DATE,STYPE,ERR) ; from LRPXAPI
 ; returns specimen node, comment, values in array DATA
 N LRDFN,LRIDT K DATA
 S ERR=0
 S LRDFN=$$LRDFN^LRPXAPIU(DFN)
 I 'LRDFN S ERR=1 Q
 I 'DATE S ERR=1 Q
 S LRIDT=$$LRIDT^LRPXAPIU(DATE)
 D LRSPEC(.DATA,LRDFN,LRIDT,STYPE,.ERR)
 Q
 ;
LRSPEC(DATA,LRDFN,LRIDT,STYPE,ERR) ; from LRPXAPI
 ; returns specimen node, comment, values in array DATA
 K DATA
 S ERR=0
 I '$O(^LR(LRDFN,"CH",LRIDT,0)) S ERR=1 Q
 I '$L(STYPE) S STYPE="A"
 I STYPE="S" D SSPEC(.DATA,LRDFN,LRIDT) Q
 I STYPE="C" D CSPEC(.DATA,LRDFN,LRIDT) Q
 I STYPE="V" D VSPEC(.DATA,LRDFN,LRIDT) Q
 I STYPE="A" D
 . N ALL K ALL
 . D SSPEC(.DATA,LRDFN,LRIDT) M ALL=DATA
 . D CSPEC(.DATA,LRDFN,LRIDT) M ALL=DATA
 . D VSPEC(.DATA,LRDFN,LRIDT) M ALL=DATA
 . K DATA M DATA=ALL
 Q
 ;
SSPEC(DATA,LRDFN,LRIDT) ; specimen node values
 K DATA
 S DATA("S")=$G(^LR(LRDFN,"CH",LRIDT,0))
 Q
 ;
CSPEC(DATA,LRDFN,LRIDT) ; specimen comments
 N CMT,CNT K DATA
 I '$D(^LR(LRDFN,"CH",LRIDT,1,0)) Q
 S CNT=0
 S CMT=0
 F  S CMT=$O(^LR(LRDFN,"CH",LRIDT,1,CMT)) Q:CMT<1  D
 . I '$D(^LR(LRDFN,"CH",LRIDT,1,CMT,0)) Q
 . S CNT=CNT+1
 . S DATA("C",CNT)=^LR(LRDFN,"CH",LRIDT,1,CMT,0)
 Q
 ;
VSPEC(DATA,LRDFN,LRIDT) ; test nodes for collected specimen
 N CNT,LRDN,VALUE K DATA
 S CNT=0
 S LRDN=1
 F  S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<2  S VALUE=^(LRDN) D
 . S CNT=CNT+1
 . S DATA("V",CNT)=LRDN_U_VALUE
 Q
 ;
COMMENT(LRDFN,LRIDT) ; $$(lrdfn,lridt) --> 1 if comment exists, else 0
 I +$O(^LR(LRDFN,"CH",LRIDT,1,0)) Q 1
 Q 0
 ;
VALUE(RESULT,DFN,DATE,TEST,COND,ERR) ; from LRPXAPI, LRPXAPI1
 ; returns result node that has met conditions as RESULT
 N LRDFN,LRIDT,LRDN
 I $L(COND),'$$CONDOK^LRPXAPIU(COND,"C") S ERR=1 Q
 I $L(COND) S COND=$$REPLACE("I "_COND)
 S RESULT=""
 S ERR=0
 S LRDFN=$$LRDFN^LRPXAPIU(DFN)
 I 'LRDFN S ERR=1 Q
 I 'DATE S ERR=1 Q
 S LRIDT=$$LRIDT^LRPXAPIU(DATE)
 S LRDN=$$LRDN^LRPXAPIU(TEST)
 I 'LRDN S ERR=1 Q
 D LRVAL(.RESULT,LRDFN,LRIDT,LRDN,COND,.ERR)
 Q
 ;
LRVALUE(RESULT,LRDFN,LRIDT,LRDN,COND,ERR) ; from LRPXAPI, LRPXAPI1
 ; returns result node that has met conditions as RESULT
 I $L(COND),'$$CONDOK^LRPXAPIU(COND,"C") S ERR=1 Q
 I $L(COND) S COND=$$REPLACE("I "_COND)
 D LRVAL(.RESULT,LRDFN,LRIDT,LRDN,COND,.ERR)
 Q
 ;
LRVAL(RESULT,LRDFN,LRIDT,LRDN,COND,ERR) ;
 N F,S,V,VALUE
 S RESULT=""
 S ERR=0
 S VALUE=$G(^LR(LRDFN,"CH",LRIDT,LRDN))
 I '$L(VALUE) S ERR=1 Q
 I $L(COND) D  I ERR Q
 . S V=$P(VALUE,U)
 . S F=$P(VALUE,U,2)
 . S S=$P($P(VALUE,U,5),"!")
 . I 'S S S=$P($G(^LR(LRDFN,"CH",LRIDT,0)),U,5)
 . X COND I '$T S ERR=1
 S RESULT=VALUE
 Q
 ;
CHNODE(ARRAY,NODE) ; from LRPXAPI
 N NAME,NAME3,NAME5,NODE3,NODE5,PIECE,PIECE3,PIECE5,SUB K ARRAY
 I '$L(NODE) Q
 S NAME="RESULT^FLAG^CODES^VERIFIER^NORMALS^DATE-R^DATE-T^^INSTITUTION^LEDI^INSTRUMENT^TYPE"
 S NAME3="NLT-O!NLT-R!LOINC!METHOD!MAP!TEST"
 S NAME5="SPEC!LOW!HIGH!LOW-C!HIGH-C!!UNITS!DELTA-T!DELTA-V!DEF!LOW-T!HIGH-T"
 F PIECE=1:1:12 D
 . I PIECE=8 Q
 . S SUB=$P(NAME,U,PIECE)
 . I PIECE=8 Q
 . I PIECE=3 D  Q
 .. S NODE3=$P(NODE,U,3)
 .. F PIECE3=1:1:6 S ARRAY($P(NAME3,"!",PIECE3))=$P(NODE3,"!",PIECE3)
 . I PIECE=5 D  Q
 .. S NODE5=$P(NODE,U,5)
 .. F PIECE5=1:1:12 D
 ... I PIECE5=6 Q
 ... S ARRAY($P(NAME5,"!",PIECE5))=$P(NODE5,"!",PIECE5)
 . S ARRAY(SUB)=$P(NODE,U,PIECE)
 Q
 ;
ACCY(TESTS,ACC,BDN) ; from LRPXAPI
 ; returns TESTS from yearly accession, ACC, BDN required
 ; BDN is beginning date number
 ; TESTS is array of file 60 iens
 N DIC,LRAA,LRAAB,LRAD,LRAN,TEST,X,Y K DIC,TESTS
 I '$L($G(ACC)) Q
 S LRAAB=$P(ACC," ")
 I LRAAB="" Q
 S BDN=$E($G(BDN))
 I BDN'>1 Q
 S LRAN=+$P(ACC," ",3)
 I 'LRAN Q
 S LRAA=+$O(^LRO(68,"B",LRAAB,0))
 I 'LRAA D
 . S DIC=68,DIC(0)="M"
 . S X=LRAAB
 . D ^DIC K DIC
 . S LRAA=+Y
 I LRAA'>0 Q
 S LRAD=BDN_$P(ACC," ",2)_"0000" ; yearly acc areas are assumed
 S TEST=0
 F  S TEST=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,TEST)) Q:TEST<1  D
 . S TESTS(TEST)=TEST_U_$$TESTNM^LRPXAPIU(TEST)
 Q
 ;
CONDOK(CONDO,TYPE) ; $$ from LRPXAPIU
 N DEL,NUM,OK,OPER,PIECE,PIECES,VALID,VALIDOP,VALUE,VAR K PIECES
 I '(TYPE="C"!(TYPE="M")!(TYPE="A")) Q 0
 S COND=CONDO
 I $E(COND)="|" S COND=$E(COND,2,245)
 I $E(COND)="~" S COND=$E(COND,2,245)
 I $L(COND)'>2 Q 0
 I $E(COND,1,2)'?1U1P Q 0
 I COND[U Q 0
 I CONDO[" " Q 0
 I CONDO["|" S DEL="|"
 E  S DEL="~"
 I '$$SYNTAX($$REPLACE(COND)) Q 0
 S PIECE=COND
 D
 . I TYPE="C" S VALID="FSV" Q
 . I TYPE="A" S VALID="CDEFIMOPST" Q
 . I TYPE="M" S VALID="ACIMORST" Q
 F NUM=1:1 Q:'$L($P(PIECE,DEL,NUM))  S PIECES(NUM)=$P(PIECE,DEL,NUM)
 S OK=1
 S NUM=0
 F  S NUM=$O(PIECES(NUM)) Q:NUM<1  D  Q:'OK
 . S PIECE=PIECES(NUM)
 . I $L(PIECE)<3 S OK=0 Q
 . S VAR=$E(PIECE)
 . I VALID'[VAR S OK=0 Q
 . D
 .. I VAR="V" S VALIDOP="=<>[]" Q
 .. I VAR="F" S VALIDOP="=[]" Q
 .. I VAR="I" S VALIDOP="=[]" Q
 .. I VAR="R" S VALIDOP="=[]" Q
 .. I VAR="S",TYPE="A" S VALIDOP="=[]" Q
 .. S VALIDOP="="
 . I $E(PIECE,3)="'" S OK=0 Q
 . I $E(PIECE,2)="'" S OPER=$E(PIECE,3)
 . E  S OPER=$E(PIECE,2)
 . I VALIDOP'[OPER S OK=0 Q
 . S VALUE=$P(PIECE,OPER,2,999)
 . I $E(VALUE)="""",$E(VALUE,$L(VALUE))'="""" S OK=0 Q
 . I VAR="C" D  Q:'OK
 .. I VALUE'?1""""1U1"""" S OK=0 Q
 .. I $$CATSUB^LRPXAPIU($E(VALUE,2),TYPE)=-1 S OK=0 Q
 . I VALUE,VALUE'=+VALUE S OK=0 Q
 . I $L($P(VALUE,"""",3)) S OK=0 Q
 . I '$$SYNTAX(PIECE) S OK=0 Q
 . I $E(PIECE,2)="=",COND[(VAR_"'=") S OK=0 Q
 I 'OK Q 0
 Q 1
 ;
REPLACE(COND) ; $$(condition) -> condition replacing | or ~ with commas
 Q $TR(COND,"~|",",,")
 ;
SYNTAX(X) ; $$(condition) -> 1 if correct, else 0
 ; check syntax when condition applies to an if statement
 S X="I "_X
 D ^DIM
 I '$D(X) Q 0
 Q 1
 ;
NORMALS(LOW,HIGH,TEST,SPEC) ; from LRPXAPIU
 N NODE
 S (LOW,HIGH)=""
 S TEST=+$G(TEST)
 I 'TEST Q
 S SPEC=+$G(SPEC)
 I 'SPEC Q
 S NODE=$G(^LAB(60,TEST,1,SPEC,0))
 S LOW=$P(NODE,U,2)
 S HIGH=$P(NODE,U,3)
 Q
 ;