Index: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC1.m
===================================================================
--- WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC1.m	(revision 623)
@@ -1,219 +1,218 @@
-ECUMRPC1	;ALB/JAM-Event Capture Management Broker Utilities ;28 Nov 00
-	;;2.0; EVENT CAPTURE ;**25,30,33,72,94**;8 May 96;Build 4
-	;
-DSSUNT(RESULTS,ECARY)	;
-	;
-	;This broker entry point returns DSS units from file 724
-	;        RPC: EC GETDSSUNIT
-	;INPUTS         ECARY - Contains the following subscripted elements
-	;               STAT   - Active or inactive DSS Units (optional)
-	;               A-ctive (default), I-nactive, B-oth
-	;
-	;OUTPUTS        RESULTS - Array of DSS units. Data pieces as follows:-
-	;               PIECE - Description
-	;                 1     IEN of DSS Unit
-	;                 2     Name of DSS Unit
-	;                 3     Service
-	;                 4     Medical Specialty
-	;                 5     Cost Center
-	;                 6     Unit Number
-	;                 7     Inactive Flag
-	;                 8     Associated Stop code (if not sending to PCE)
-	;                 9     Category flag
-	;                 10    Default date entry
-	;                 11    Send to PCE Flag
-	;
-	N UNT,STAT,CNT,CAT,NODE,ECS,STR,SRV,MED,CST,UNO,INACT,ASC,PCE,ACT,NODE
-	N DFD
-	D SETENV^ECUMRPC
-	K ^TMP($J,"ECDSSUNT")
-	S STAT=$P($G(ECARY),U),(CNT,UNT)=0 S:STAT="" STAT="A"
-	F  S UNT=$O(^ECD(UNT)) Q:'UNT  S NODE=$G(^ECD(UNT,0)) I NODE'="" D
-	. S ECS=$P(NODE,U,8),ACT=$P(NODE,U,6),ACT=$S(ACT:1,1:0)
-	. Q:'ECS  I $S(STAT="A"&(ACT):1,STAT="I"&('ACT):1,1:0) Q
-	. S CNT=CNT+1,CAT=$P(NODE,U,11),CAT=$S(CAT:"Y",1:"N"),UNO=$P(NODE,U,5)
-	. S SRV=$$GET1^DIQ(49,$P(NODE,U,2),.01,"I")
-	. S MED=$$GET1^DIQ(723,$P(NODE,U,3),.01,"I")
-	. S CST=$$GET1^DIQ(420.1,$P(NODE,U,4),.01,"I")
-	. S INACT=$P(NODE,U,6),INACT=$S(INACT:"I",1:"A"),ASC=$P(NODE,U,10)
-	. S:ASC ASC=$$GET1^DIQ(40.7,ASC,.01,"I")
-	. S DFD=$S($P(NODE,U,12)="N":"N",1:"X"),PCE=$P(NODE,U,14)
-	. S PCE=$S(PCE="A":PCE,PCE="O":PCE,1:"N")
-	. S STR=UNT_U_$P(NODE,U)_U_SRV_U_MED_U_CST_U_UNO_U_INACT_U_ASC_U_CAT
-	. S STR=STR_U_DFD_U_PCE,^TMP($J,"ECDSSUNT",CNT)=STR
-	S RESULTS=$NA(^TMP($J,"ECDSSUNT"))
-	Q
-CAT(RESULTS,ECARY)	;
-	;
-	;This broker entry point returns a list of categories from file 726
-	;        RPC: EC GETCAT
-	;INPUTS         ECARY - Contains the following subscripted elements
-	;                STAT - Active or inactive category (optional)
-	;                A-ctive (default), I-nactive, B-oth
-	;
-	;OUTPUTS        RESULTS - Array of category. Data pieces as follows:-
-	;               PIECE - Description
-	;                 1     IEN of Category
-	;                 2     Name of Category
-	;                 3     Creation Date
-	;                 4     Inactive Date
-	;
-	N STAT,CNT,CAT,NODE,ECDT,INDT,CRDT
-	D SETENV^ECUMRPC
-	K ^TMP($J,"ECCAT")
-	S STAT=$P($G(ECARY),U),(CNT,CAT)=0 S:STAT="" STAT="A"
-	F  S CAT=$O(^EC(726,CAT)) Q:'CAT  S NODE=$G(^EC(726,CAT,0)) I NODE'="" D
-	. S ECDT=$P(NODE,U,3)
-	. I STAT="A",ECDT'="",ECDT'>DT Q
-	. I STAT="I",ECDT="" Q
-	. S CRDT=$$FMTE^XLFDT($P(NODE,U,2),"2F")
-	. S INDT=$$FMTE^XLFDT($P(NODE,U,3),"2F")
-	. ;S CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_CRDT_U_INDT
-	. S CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_$P(CRDT,"@",1)_U_$P(INDT,"@",1)
-	S RESULTS=$NA(^TMP($J,"ECCAT"))
-	Q
-	;
-CATCHK(RESULTS,ECARY)	;
-	;
-	;Broker call checks whether category is used in an Event Code Screen.
-	;        RPC: EC DSSCATCHECK
-	;INPUTS   ECARY  - Contains the following subscripted elements
-	;          ECDA  - DSS Unit ien (file #724)
-	;
-	;OUTPUTS  RESULTS - Category used in Event Code Screen, 1-Yes or 0-No
-	;
-	N ECDA,ECFLG,ECX
-	D SETENV^ECUMRPC
-	S ECDA=$P(ECARY,U) I ECDA="" Q
-	S (ECFLG,ECX)=0
-	F  S ECX=$O(^ECJ("AP",ECX)) Q:'ECX!(ECFLG)  D
-	. I $D(^ECJ("AP",ECX,ECDA)) S ECFLG=1
-	S RESULTS=ECFLG
-	Q
-PXCHK(RESULTS,ECARY)	;
-	;
-	;Checks whether procedure description or national number exist
-	;INPUTS   ECARY  - Contains the following subscripted elements
-	;          ECP - Procedure description
-	;          ECN - EC National Number
-	;
-	;OUTPUTS  RESULTS - Px used^National # used, 1-Yes or 0-No ex. 1^0
-	;
-	N ECX,ECP,ECN
-	Q:$G(ECARY)
-	D SETENV^ECUMRPC
-	S ECP=$P(ECARY,U),ECN=$P(ECARY,U,2),RESULTS="0^0"
-	I ECP'="",$D(^EC(725,"B",ECP)) S $P(RESULTS,U)=1
-	I ECN'="" F ECX="E","D","DL" D  I $P(RESULTS,U,2) Q
-	. I $D(^EC(725,ECX,ECN)) S $P(RESULTS,U,2)=1
-	Q
-SRCLST(RESULTS,ECARY)	;
-	;
-	;This broker entry returns an array of codes from a file based on a 
-	;search string.
-	;        RPC: EC GETLIST
-	;
-	;INPUTS      ECARY   - Contains the following subscripted elements
-	;             ECSTR  - Search string
-	;             ECFIL  - File to search
-	;             ECDIR  - Search order
-	;
-	;OUTPUTS     RESULTS - Array of values based on the search criteria.
-	;
-	N ECNT,DIC,ECSTR,ECFIL,ECORD,ECER,ECDI
-	D SETENV^ECUMRPC
-	S ECNT=0,ECFIL=$P(ECARY,U),ECSTR=$P(ECARY,U,2),ECDIR=$P(ECARY,U,3)
-	S ECORD=$S(ECDIR=-1:"B",1:"I")
-	K ^TMP($J,"ECFIND"),^TMP("ECSRCH",$J)
-	I ECFIL="" Q
-	S ECNUM=44
-	I ECFIL=420.1 D CSTCTR            ;Cost Center search
-	I ECFIL=49 D SERVC                ;Service search
-	I ECFIL=723 D MEDSPC              ;Medical specialty
-	I ECFIL=40.7 D STPCDE G EXIT      ;Associated stop code
-	I ECFIL=724 D DUNT G EXIT         ;DSS Unit
-	I ECFIL=726 D ECAT                ;Category
-	I ECFIL=4 D LOC                   ;Location
-	I ECFIL=44 D ASCLN G EXIT         ;Associated clinic
-	I ECFIL=757.01 D LEX^ECUMRPC2 G EXIT  ;Lex ICD code
-	I ECFIL=200 D PROV^ECUMRPC2      ;Providers
-	I $D(ECER) S ^TMP($J,"ECFIND",1)="0^Error occurred during search" G EXIT
-	D SORT
-EXIT	K ^TMP("ECSRCH",$J)
-	S RESULTS=$NA(^TMP($J,"ECFIND"))
-	Q
-ASCLN	;Search for active associated clinics (file #44)
-	N CNT,NOD,ECDT,INACT,REACT,ERR
-	S CNT=0,ECDT=DT
-	F  Q:CNT=ECNUM  S ECSTR=$O(^SC("B",ECSTR),ECDIR) Q:ECSTR=""  S CLN="" D
-	.F  S CLN=$O(^SC("B",ECSTR,CLN),ECDIR) Q:CLN=""  S NOD=$G(^SC(CLN,0)) D
-	..Q:NOD=""  Q:$P(NOD,U,3)'="C"  ;Q:+$G(^SC(CLN,"OOS"))
-	..S ERR=0 I $D(^SC(CLN,"I")) D  I ERR Q
-	...S INACT=$P(^SC(CLN,"I"),U),REACT=$P(^SC(CLN,"I"),U,2)
-	...I INACT D  I ERR Q
-	....I REACT="" S:ECDT'<INACT ERR=1 Q
-	....I ECDT'<INACT,ECDT<REACT S ERR=1 Q
-	...I REACT,ECDT<REACT S ERR=1
-	..S CNT=CNT+1,^TMP($J,"ECFIND",CNT)=CLN_U_$P(NOD,U)
-	Q
-CSTCTR	;Search for cost centers (File #420.1)
-	N ECNULL,INDX,STR,NSTR,I
-	S $P(ECNULL," ",7)=" ",INDX="B"
-	I $E(ECSTR)?.N,$L(ECSTR)<7 S ECSTR=ECSTR_$E(ECNULL,1,7-$L(ECSTR))
-	I $L($P(ECSTR," "))=6,$P(ECSTR," ",2)?.A D   ;truncate for x-ref
-	. S ECSTR=$P(ECSTR," ")_" "_$E($P(ECSTR," ",2,999),1,22)
-	I $E(ECSTR)?.A S INDX="C",(STR,NSTR)="" D  S ECSTR=NSTR
-	.F I=1:1 S STR=$P(ECSTR," ",I) Q:STR=""  D
-	..S STR=$E(STR)_$TR($E(STR,2,9999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
-	..S NSTR=NSTR_STR
-	D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"",INDX,"I '$P(^(0),U,2)","","^TMP(""ECSRCH"",$J)","ECER")
-	Q
-SERVC	;Search for services (File #49)
-	D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
-	Q
-MEDSPC	;Search for medical specialty (File #723)
-	D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
-	Q
-STPCDE	;Search for associated stop code (File #40.7)
-	N ECNT,INDX,ECNUL,STR,IEN
-	S $P(ECNUL,"  ",30)=" ",INDX="B",ECNT=0,ECSTR=$P(ECSTR,"~")
-	I +ECSTR,+ECSTR?.N S INDX="C",IEN=0 D  Q
-	.S ECSTR=$O(^DIC(40.7,INDX,+ECSTR)) I ECSTR="" Q
-	.F  S IEN=$O(^DIC(40.7,INDX,ECSTR,IEN)) Q:'IEN  D  I ECNT>(ECNUM-1) Q
-	..S STR=$G(^DIC(40.7,IEN,0)) I (STR="")!($P(STR,U,3)'="") Q
-	..S STR=$E($P(STR,U),1,30)_"  ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)_U_IEN
-	..S ECNT=ECNT+1,^TMP($J,"ECFIND",ECNT)=STR
-	D LISTDIC(ECFIL,"",".01;1",ECORD,ECNUM,ECSTR,"",INDX,"I $P(^(0),""^"",3)=""""!($P(^(0),U,3)'<DT)","","^TMP(""ECSRCH"",$J)","ECER")
-	S ECNT=0
-	F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
-	.S STR=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_$G(^(1))
-	.S STR=$E($P(STR,U),1,30)_"  ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)
-	.S ^TMP($J,"ECFIND",ECNT)=STR_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)
-	Q
-DUNT	;Search for DSS unit (File #724)
-	N ECNT,SNDPCE
-	D LISTDIC(ECFIL,"",".01;10;13",ECORD,ECNUM,ECSTR,"","","I '$P(^(0),""^"",6),$P(^(0),U,8)","","^TMP(""ECSRCH"",$J)","ECER")
-	S ECNT=0
-	F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
-	.S SNDPCE=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,13))
-	.S SNDPCE=$S(SNDPCE="O":1,SNDPCE="A":1,1:0)
-	.S ^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)_U_$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,10))_U_SNDPCE
-	Q
-ECAT	;Search for Category (File #726)
-	D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $P(^(0),""^"",3)=""""!($P(^(0),U,3)>DT)","","^TMP(""ECSRCH"",$J)","ECER")
-	Q
-LOC	;Search for Location (File #4)
-	D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $G(^(""EC""))","","^TMP(""ECSRCH"",$J)","ECER")
-	Q
-LISTDIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER)	;
-	;Produces a list of records in a file base on search string
-	N DIC
-	D LIST^DIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER)
-	K ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECID
-	Q
-SORT	;Extracts data to be returned to broker
-	N ECNT,STR
-	S ECNT=0
-	F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
-	.S ^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)
-	Q
+ECUMRPC1 ;ALB/JAM-Event Capture Management Broker Utilities ;28 Nov 00
+ ;;2.0; EVENT CAPTURE ;**25,30,33,72**;8 May 96
+ ;
+DSSUNT(RESULTS,ECARY) ;
+ ;
+ ;This broker entry point returns DSS units from file 724
+ ;        RPC: EC GETDSSUNIT
+ ;INPUTS         ECARY - Contains the following subscripted elements
+ ;               STAT   - Active or inactive DSS Units (optional)
+ ;               A-ctive (default), I-nactive, B-oth
+ ;
+ ;OUTPUTS        RESULTS - Array of DSS units. Data pieces as follows:-
+ ;               PIECE - Description
+ ;                 1     IEN of DSS Unit
+ ;                 2     Name of DSS Unit
+ ;                 3     Service
+ ;                 4     Medical Specialty
+ ;                 5     Cost Center
+ ;                 6     Unit Number
+ ;                 7     Inactive Flag
+ ;                 8     Associated Stop code (if not sending to PCE)
+ ;                 9     Category flag
+ ;                 10    Default date entry
+ ;                 11    Send to PCE Flag
+ ;
+ N UNT,STAT,CNT,CAT,NODE,ECS,STR,SRV,MED,CST,UNO,INACT,ASC,PCE,ACT,NODE
+ N DFD
+ D SETENV^ECUMRPC
+ K ^TMP($J,"ECDSSUNT")
+ S STAT=$P($G(ECARY),U),(CNT,UNT)=0 S:STAT="" STAT="A"
+ F  S UNT=$O(^ECD(UNT)) Q:'UNT  S NODE=$G(^ECD(UNT,0)) I NODE'="" D
+ . S ECS=$P(NODE,U,8),ACT=$P(NODE,U,6),ACT=$S(ACT:1,1:0)
+ . Q:'ECS  I $S(STAT="A"&(ACT):1,STAT="I"&('ACT):1,1:0) Q
+ . S CNT=CNT+1,CAT=$P(NODE,U,11),CAT=$S(CAT:"Y",1:"N"),UNO=$P(NODE,U,5)
+ . S SRV=$$GET1^DIQ(49,$P(NODE,U,2),.01,"I")
+ . S MED=$$GET1^DIQ(723,$P(NODE,U,3),.01,"I")
+ . S CST=$$GET1^DIQ(420.1,$P(NODE,U,4),.01,"I")
+ . S INACT=$P(NODE,U,6),INACT=$S(INACT:"I",1:"A"),ASC=$P(NODE,U,10)
+ . S:ASC ASC=$$GET1^DIQ(40.7,ASC,.01,"I")
+ . S DFD=$S($P(NODE,U,12)="N":"N",1:"X"),PCE=$P(NODE,U,14)
+ . S PCE=$S(PCE="A":PCE,PCE="O":PCE,1:"N")
+ . S STR=UNT_U_$P(NODE,U)_U_SRV_U_MED_U_CST_U_UNO_U_INACT_U_ASC_U_CAT
+ . S STR=STR_U_DFD_U_PCE,^TMP($J,"ECDSSUNT",CNT)=STR
+ S RESULTS=$NA(^TMP($J,"ECDSSUNT"))
+ Q
+CAT(RESULTS,ECARY) ;
+ ;
+ ;This broker entry point returns a list of categories from file 726
+ ;        RPC: EC GETCAT
+ ;INPUTS         ECARY - Contains the following subscripted elements
+ ;                STAT - Active or inactive category (optional)
+ ;                A-ctive (default), I-nactive, B-oth
+ ;
+ ;OUTPUTS        RESULTS - Array of category. Data pieces as follows:-
+ ;               PIECE - Description
+ ;                 1     IEN of Category
+ ;                 2     Name of Category
+ ;                 3     Creation Date
+ ;                 4     Inactive Date
+ ;
+ N STAT,CNT,CAT,NODE,ECDT,INDT,CRDT
+ D SETENV^ECUMRPC
+ K ^TMP($J,"ECCAT")
+ S STAT=$P($G(ECARY),U),(CNT,CAT)=0 S:STAT="" STAT="A"
+ F  S CAT=$O(^EC(726,CAT)) Q:'CAT  S NODE=$G(^EC(726,CAT,0)) I NODE'="" D
+ . S ECDT=$P(NODE,U,3)
+ . I STAT="A",ECDT'="",ECDT'>DT Q
+ . I STAT="I",ECDT="" Q
+ . S CRDT=$$FMTE^XLFDT($P(NODE,U,2),"2F")
+ . S INDT=$$FMTE^XLFDT($P(NODE,U,3),"2F")
+ . S CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_CRDT_U_INDT
+ S RESULTS=$NA(^TMP($J,"ECCAT"))
+ Q
+ ;
+CATCHK(RESULTS,ECARY) ;
+ ;
+ ;Broker call checks whether category is used in an Event Code Screen.
+ ;        RPC: EC DSSCATCHECK
+ ;INPUTS   ECARY  - Contains the following subscripted elements
+ ;          ECDA  - DSS Unit ien (file #724)
+ ;
+ ;OUTPUTS  RESULTS - Category used in Event Code Screen, 1-Yes or 0-No
+ ;
+ N ECDA,ECFLG,ECX
+ D SETENV^ECUMRPC
+ S ECDA=$P(ECARY,U) I ECDA="" Q
+ S (ECFLG,ECX)=0
+ F  S ECX=$O(^ECJ("AP",ECX)) Q:'ECX!(ECFLG)  D
+ . I $D(^ECJ("AP",ECX,ECDA)) S ECFLG=1
+ S RESULTS=ECFLG
+ Q
+PXCHK(RESULTS,ECARY) ;
+ ;
+ ;Checks whether procedure description or national number exist
+ ;INPUTS   ECARY  - Contains the following subscripted elements
+ ;          ECP - Procedure description
+ ;          ECN - EC National Number
+ ;
+ ;OUTPUTS  RESULTS - Px used^National # used, 1-Yes or 0-No ex. 1^0
+ ;
+ N ECX,ECP,ECN
+ Q:$G(ECARY)
+ D SETENV^ECUMRPC
+ S ECP=$P(ECARY,U),ECN=$P(ECARY,U,2),RESULTS="0^0"
+ I ECP'="",$D(^EC(725,"B",ECP)) S $P(RESULTS,U)=1
+ I ECN'="" F ECX="E","D","DL" D  I $P(RESULTS,U,2) Q
+ . I $D(^EC(725,ECX,ECN)) S $P(RESULTS,U,2)=1
+ Q
+SRCLST(RESULTS,ECARY) ;
+ ;
+ ;This broker entry returns an array of codes from a file based on a 
+ ;search string.
+ ;        RPC: EC GETLIST
+ ;
+ ;INPUTS      ECARY   - Contains the following subscripted elements
+ ;             ECSTR  - Search string
+ ;             ECFIL  - File to search
+ ;             ECDIR  - Search order
+ ;
+ ;OUTPUTS     RESULTS - Array of values based on the search criteria.
+ ;
+ N ECNT,DIC,ECSTR,ECFIL,ECORD,ECER,ECDI
+ D SETENV^ECUMRPC
+ S ECNT=0,ECFIL=$P(ECARY,U),ECSTR=$P(ECARY,U,2),ECDIR=$P(ECARY,U,3)
+ S ECORD=$S(ECDIR=-1:"B",1:"I")
+ K ^TMP($J,"ECFIND"),^TMP("ECSRCH",$J)
+ I ECFIL="" Q
+ S ECNUM=44
+ I ECFIL=420.1 D CSTCTR            ;Cost Center search
+ I ECFIL=49 D SERVC                ;Service search
+ I ECFIL=723 D MEDSPC              ;Medical specialty
+ I ECFIL=40.7 D STPCDE G EXIT      ;Associated stop code
+ I ECFIL=724 D DUNT G EXIT         ;DSS Unit
+ I ECFIL=726 D ECAT                ;Category
+ I ECFIL=4 D LOC                   ;Location
+ I ECFIL=44 D ASCLN G EXIT         ;Associated clinic
+ I ECFIL=757.01 D LEX^ECUMRPC2 G EXIT  ;Lex ICD code
+ I ECFIL=200 D PROV^ECUMRPC2      ;Providers
+ I $D(ECER) S ^TMP($J,"ECFIND",1)="0^Error occurred during search" G EXIT
+ D SORT
+EXIT K ^TMP("ECSRCH",$J)
+ S RESULTS=$NA(^TMP($J,"ECFIND"))
+ Q
+ASCLN ;Search for active associated clinics (file #44)
+ N CNT,NOD,ECDT,INACT,REACT,ERR
+ S CNT=0,ECDT=DT
+ F  Q:CNT=ECNUM  S ECSTR=$O(^SC("B",ECSTR),ECDIR) Q:ECSTR=""  S CLN="" D
+ .F  S CLN=$O(^SC("B",ECSTR,CLN),ECDIR) Q:CLN=""  S NOD=$G(^SC(CLN,0)) D
+ ..Q:NOD=""  Q:$P(NOD,U,3)'="C"  ;Q:+$G(^SC(CLN,"OOS"))
+ ..S ERR=0 I $D(^SC(CLN,"I")) D  I ERR Q
+ ...S INACT=$P(^SC(CLN,"I"),U),REACT=$P(^SC(CLN,"I"),U,2)
+ ...I INACT D  I ERR Q
+ ....I REACT="" S:ECDT'<INACT ERR=1 Q
+ ....I ECDT'<INACT,ECDT<REACT S ERR=1 Q
+ ...I REACT,ECDT<REACT S ERR=1
+ ..S CNT=CNT+1,^TMP($J,"ECFIND",CNT)=CLN_U_$P(NOD,U)
+ Q
+CSTCTR ;Search for cost centers (File #420.1)
+ N ECNULL,INDX,STR,NSTR,I
+ S $P(ECNULL," ",7)=" ",INDX="B"
+ I $E(ECSTR)?.N,$L(ECSTR)<7 S ECSTR=ECSTR_$E(ECNULL,1,7-$L(ECSTR))
+ I $L($P(ECSTR," "))=6,$P(ECSTR," ",2)?.A D   ;truncate for x-ref
+ . S ECSTR=$P(ECSTR," ")_" "_$E($P(ECSTR," ",2,999),1,22)
+ I $E(ECSTR)?.A S INDX="C",(STR,NSTR)="" D  S ECSTR=NSTR
+ .F I=1:1 S STR=$P(ECSTR," ",I) Q:STR=""  D
+ ..S STR=$E(STR)_$TR($E(STR,2,9999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+ ..S NSTR=NSTR_STR
+ D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"",INDX,"I '$P(^(0),U,2)","","^TMP(""ECSRCH"",$J)","ECER")
+ Q
+SERVC ;Search for services (File #49)
+ D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
+ Q
+MEDSPC ;Search for medical specialty (File #723)
+ D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
+ Q
+STPCDE ;Search for associated stop code (File #40.7)
+ N ECNT,INDX,ECNUL,STR,IEN
+ S $P(ECNUL,"  ",30)=" ",INDX="B",ECNT=0,ECSTR=$P(ECSTR,"~")
+ I +ECSTR,+ECSTR?.N S INDX="C",IEN=0 D  Q
+ .S ECSTR=$O(^DIC(40.7,INDX,+ECSTR)) I ECSTR="" Q
+ .F  S IEN=$O(^DIC(40.7,INDX,ECSTR,IEN)) Q:'IEN  D  I ECNT>(ECNUM-1) Q
+ ..S STR=$G(^DIC(40.7,IEN,0)) I (STR="")!($P(STR,U,3)'="") Q
+ ..S STR=$E($P(STR,U),1,30)_"  ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)_U_IEN
+ ..S ECNT=ECNT+1,^TMP($J,"ECFIND",ECNT)=STR
+ D LISTDIC(ECFIL,"",".01;1",ECORD,ECNUM,ECSTR,"",INDX,"I $P(^(0),""^"",3)=""""!($P(^(0),U,3)'<DT)","","^TMP(""ECSRCH"",$J)","ECER")
+ S ECNT=0
+ F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
+ .S STR=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_$G(^(1))
+ .S STR=$E($P(STR,U),1,30)_"  ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)
+ .S ^TMP($J,"ECFIND",ECNT)=STR_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)
+ Q
+DUNT ;Search for DSS unit (File #724)
+ N ECNT,SNDPCE
+ D LISTDIC(ECFIL,"",".01;10;13",ECORD,ECNUM,ECSTR,"","","I '$P(^(0),""^"",6),$P(^(0),U,8)","","^TMP(""ECSRCH"",$J)","ECER")
+ S ECNT=0
+ F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
+ .S SNDPCE=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,13))
+ .S SNDPCE=$S(SNDPCE="O":1,SNDPCE="A":1,1:0)
+ .S ^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)_U_$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,10))_U_SNDPCE
+ Q
+ECAT ;Search for Category (File #726)
+ D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $P(^(0),""^"",3)=""""!($P(^(0),U,3)>DT)","","^TMP(""ECSRCH"",$J)","ECER")
+ Q
+LOC ;Search for Location (File #4)
+ D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $G(^(""EC""))","","^TMP(""ECSRCH"",$J)","ECER")
+ Q
+LISTDIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER) ;
+ ;Produces a list of records in a file base on search string
+ N DIC
+ D LIST^DIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER)
+ K ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECID
+ Q
+SORT ;Extracts data to be returned to broker
+ N ECNT,STR
+ S ECNT=0
+ F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
+ .S ^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)
+ Q
