ECUMRPC2 ;ALB/JAM;Event Capture Management Broker Utils ; 10/4/00 4:58pm ;;2.0; EVENT CAPTURE ;**25,30,42,46,47,49,75,72**;8 May 96 GLOC(RESULTS,ECARY) ; ; ;This broker entry point returns all active Event Capture locations ; RPC: EC GETLOC ;INPUTS ECARY - Contains the following subscripted elements ; STAT - Active or inactive locations (optional) ; A-ctive (default), I-nactive, B-oth ; ;OUTPUTS RESULTS - The array of active Event Capture locations. ; PIECE - Description ; 1 Location IEN ; 2 LOC description ; 3 State Abbreviation ; 4 Current Location Flag ; 5 Facility Type ; 6 Station Number N LOC,STAT,CNT,CLOC,ST,NODE,ACT,ECLOC,ELOC,ECFT,ECSN D SETENV^ECUMRPC K ^TMP($J,"ECLOCATION") S STAT=$P($G(ECARY),U),(CNT,LOC)=0,ACT=0 S:STAT="" STAT="A" D GETLOC^ECL(.ECLOC) F S LOC=$O(ECLOC(LOC)) Q:'LOC S ELOC($P(ECLOC(LOC),U,2))="" S LOC=0 F S LOC=$O(^DIC(4,LOC)) Q:'LOC S NODE=$G(^DIC(4,LOC,0)) I NODE'="" D . I $P(NODE,U)="" Q . I ($P(NODE,U,11)="I")!($P($G(^DIC(4,LOC,99)),U,4)) S ACT=1 . I $S(STAT="A"&(ACT):1,STAT="I"&('ACT):1,1:0) Q . S CLOC=$D(ELOC(LOC)),CLOC=$S(CLOC:"YES",1:"") . S CNT=CNT+1,ST=$P(NODE,U,2) S:ST'="" ST=$$GET1^DIQ(5,ST,1,"I") . S ECFT=$P($G(^DIC(4.1,+$G(^DIC(4,LOC,3)),0)),U) . S ECSN=$P($G(^DIC(4,LOC,99)),U) . S ^TMP($J,"ECLOCATION",CNT)=LOC_U_$P(NODE,U)_U_ST_U_CLOC_U_ECFT_U_ECSN S RESULTS=$NA(^TMP($J,"ECLOCATION")) Q CPTFND(RESULTS,ECARY) ; ; ;This broker entry point does a search on a CPT string and returns ;a list of matches from file #81 ; RPC: EC GETCPTLST ;INPUTS ECARY - Contains the following subscripted elements ; CPTSTR - CPT search string ; ;OUTPUTS RESULTS - The array of cpt codes. Data pieces as follows:- ; CPT ien^CPT code^Name ; N CPTSTR,ECNT,DIC,ECTG,ECER D SETENV^ECUMRPC S CPTSTR=$P(ECARY,U),ECNT=0 I CPTSTR="" Q K ^TMP($J,"ECPTSRCH"),^TMP("ECCPT",$J) D CPTSRH(81,CPTSTR) F S ECNT=$O(^TMP("ECCPT",$J,"DILIST","ID",ECNT)) Q:'ECNT D .S ^TMP($J,"ECPTSRCH",ECNT)=$G(^TMP("ECCPT",$J,"DILIST",2,ECNT))_U_^TMP("ECCPT",$J,"DILIST","ID",ECNT,.01)_U_^TMP("ECCPT",$J,"DILIST","ID",ECNT,2) K ^TMP("ECCPT",$J) S RESULTS=$NA(^TMP($J,"ECPTSRCH")) Q ; PXFND(RESULTS,ECARY) ; ; ;This broker entry point does a search on a procedure string and returns ;a list of matches from file #81 and/or #725 ; RPC: EC GETPXLST ;INPUTS ECARY - Contains the following subscripted elements ; PXSTR - Procedure search string ; ;OUTPUTS RESULTS - The array of procedures. Data pieces as follows:- ; Procedure ien^Procedure code Procedure Name ; N CPTSTR,ECNT,DIC,ECX,CNT,ECTG,ECER,PXSTR,ECSTR D SETENV^ECUMRPC S PXSTR=$P(ECARY,U),ECNT=0 I PXSTR="" Q K ^TMP($J,"ECPXSRCH"),^TMP("ECCPT",$J),^TMP("ECCPT1",$J) D . I $P(PXSTR,".")="A" D CPTSRH(81,$P(PXSTR,".",2)) Q . I $P(PXSTR,".")="B" D CPTSRH(725,$P(PXSTR,".",2)) Q . F ECX=81,725 D CPTSRH(ECX,PXSTR) F S ECNT=$O(^TMP("ECCPT",$J,"DILIST","ID",ECNT)) Q:'ECNT D .S ECID=$G(^TMP("ECCPT",$J,"DILIST",2,ECNT))_";ICPT(" .S ECSTR=^TMP("ECCPT",$J,"DILIST","ID",ECNT,.01)_" "_^(2) .S ^TMP($J,"ECPXSRCH",ECNT)=ECID_U_ECSTR S ECNT=0,CNT=+$O(^TMP($J,"ECPXSRCH","A"),-1) F S ECNT=$O(^TMP("ECCPT1",$J,"DILIST","ID",ECNT)) Q:'ECNT D .S CNT=CNT+1,ECID=$G(^TMP("ECCPT1",$J,"DILIST",2,ECNT))_";EC(725," .S ECSTR=^TMP("ECCPT1",$J,"DILIST","ID",ECNT,1)_" "_^(.01) .S ^TMP($J,"ECPXSRCH",CNT)=ECID_U_ECSTR K ^TMP("ECCPT",$J),^TMP("ECCPT1",$J) S RESULTS=$NA(^TMP($J,"ECPXSRCH")) Q CPTSRH(FILE,CPTSTR) ;Searches either file 81 or 725 for a CPT string I FILE=81 D .D FINDIC(81,"",".01;2","M",CPTSTR,100,"","I $P($$CPT^ICPTCOD(+Y),""^"",7)","","^TMP(""ECCPT"",$J)") I FILE=725 D .D FINDIC(725,"",".01;1","M",CPTSTR,100,"","I '$P(^(0),""^"",3)","","^TMP(""ECCPT1"",$J)") Q FINDIC(ECFL,ECIEN,ECFLD,ECFLG,ECVAL,ECN,ECINDX,ECSCN,ECID,ECTG,ECER) ; ;Find records in a file base on search string S ECER=$G(ECER) D FIND^DIC(ECFL,ECIEN,ECFLD,ECFLG,ECVAL,ECN,ECINDX,ECSCN,ECID,ECTG,ECER) K ECFL,ECIEN,ECFLD,ECFLG,ECVAL,ECN,ECINDX,ECSCN,ECID Q PROV ;Return a set of providers from the NEW PERSON file ;Input Variables:- ; FROM - text to $O from ; DATE - checks for an active person class on this date (optional) ; ECDIR - $O direction ; KEY - screen users by security key (optional) ; ;Output Variables:- ; ^TMP($J,"ECFIND",1..n - returned array ; IEN of file 200^Provider Name^occupation^specialty^subspecialty ; N I,IEN,CNT,FROM,DATE,ECUTN S I=0,CNT=44 ;KEY="PROVIDER" ;S FROM=$P(ECSTR,"|"),DATE=$P(ECSTR,"|",2) S FROM=$P(ECSTR,"|"),DATE=$P(ECSTR,"|",2),REPORT=$P(ECSTR,"|",3) F Q:I'0,ECUTN<1 Q . . S I=I+1,^TMP($J,"ECFIND",I)=IEN_"^"_FROM_"^"_$P(ECUTN,"^",2,4) Q LEX ; returns a list of ICD code from lexicon lookup; called from ECUMRPC1 ;Input Variables:- ; ECSTR - APP|ECX|ECDT ; application|Search string|procedure date ; ;Output Variables:- ; ^TMP($J,"ECFIND",1..n - returned array ; ICD9 Code^LEX description^IEN of file 80^IEN of file 757.01 ; N LEX,ILST,I,IEN,ECX,APP,ECDT,ICD9,ICDIEN,DIC,ECCD S APP=$P(ECSTR,"|"),ECX=$P(ECSTR,"|",2),ECDT=$P(ECSTR,"|",3) S ECDT=$G(ECDT,DT),DIC="^ICD9(" ;spacebar default for DUZ I ECX=" ",+($G(DUZ))>0 S IEN=$G(^DISV(DUZ,DIC)) I +IEN D .S ECCD=$$ICDDX^ICDCODE(IEN,ECDT) S:+ECCD>0 ECX=$P(ECCD,U,2) D CONFIG^LEXSET(APP,APP,ECDT) ;LEX DBIA1577 D LOOK^LEXA(ECX,APP,1,"",ECDT) ;LEX DBIA2950 I '$D(LEX("LIST",1)) S ^TMP($J,"ECFIND",1)="0^No matches found." Q ;LEX DBIA1573 S ILST=1,IEN=+LEX("LIST",1) D ICD I ICDIEN<0 S ^TMP($J,"ECFIND",1)="0^No matches found." Q S ^TMP($J,"ECFIND",ILST)=ICD9_U_$P(LEX("LIST",1),U,2)_U_ICDIEN_U_LEX("LIST",1),I="" F S I=$O(^TMP("LEXFND",$J,I)) Q:I'<0 D . S IEN=$O(^TMP("LEXFND",$J,I,0)) . D ICD I ICDIEN<0 Q . S ILST=ILST+1 . S ^TMP($J,"ECFIND",ILST)=ICD9_U_^TMP("LEXFND",$J,I,IEN)_U_ICDIEN_U_IEN I $O(^TMP($J,"ECFIND",0))="" S ^TMP($J,"ECFIND",1)="0^No matches found." K ^TMP("LEXFND",$J),^TMP("LEXHIT",$J) Q ICD ;ICD code S ICD9=$$ICDONE^LEXU(IEN,ECDT) S ICDIEN=+$$ICDDX^ICDCODE(ICD9,ECDT) Q