- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC1.m
r613 r623 1 ECUMRPC1 ;ALB/JAM-Event Capture Management Broker Utilities ;28 Nov 00 2 ;;2.0; EVENT CAPTURE ;**25,30,33,72,94**;8 May 96;Build 4 3 ; 4 DSSUNT(RESULTS,ECARY) ; 5 ; 6 ;This broker entry point returns DSS units from file 724 7 ; RPC: EC GETDSSUNIT 8 ;INPUTS ECARY - Contains the following subscripted elements 9 ; STAT - Active or inactive DSS Units (optional) 10 ; A-ctive (default), I-nactive, B-oth 11 ; 12 ;OUTPUTS RESULTS - Array of DSS units. Data pieces as follows:- 13 ; PIECE - Description 14 ; 1 IEN of DSS Unit 15 ; 2 Name of DSS Unit 16 ; 3 Service 17 ; 4 Medical Specialty 18 ; 5 Cost Center 19 ; 6 Unit Number 20 ; 7 Inactive Flag 21 ; 8 Associated Stop code (if not sending to PCE) 22 ; 9 Category flag 23 ; 10 Default date entry 24 ; 11 Send to PCE Flag 25 ; 26 N UNT,STAT,CNT,CAT,NODE,ECS,STR,SRV,MED,CST,UNO,INACT,ASC,PCE,ACT,NODE 27 N DFD 28 D SETENV^ECUMRPC 29 K ^TMP($J,"ECDSSUNT") 30 S STAT=$P($G(ECARY),U),(CNT,UNT)=0 S:STAT="" STAT="A" 31 F S UNT=$O(^ECD(UNT)) Q:'UNT S NODE=$G(^ECD(UNT,0)) I NODE'="" D 32 . S ECS=$P(NODE,U,8),ACT=$P(NODE,U,6),ACT=$S(ACT:1,1:0) 33 . Q:'ECS I $S(STAT="A"&(ACT):1,STAT="I"&('ACT):1,1:0) Q 34 . S CNT=CNT+1,CAT=$P(NODE,U,11),CAT=$S(CAT:"Y",1:"N"),UNO=$P(NODE,U,5) 35 . S SRV=$$GET1^DIQ(49,$P(NODE,U,2),.01,"I") 36 . S MED=$$GET1^DIQ(723,$P(NODE,U,3),.01,"I") 37 . S CST=$$GET1^DIQ(420.1,$P(NODE,U,4),.01,"I") 38 . S INACT=$P(NODE,U,6),INACT=$S(INACT:"I",1:"A"),ASC=$P(NODE,U,10) 39 . S:ASC ASC=$$GET1^DIQ(40.7,ASC,.01,"I") 40 . S DFD=$S($P(NODE,U,12)="N":"N",1:"X"),PCE=$P(NODE,U,14) 41 . S PCE=$S(PCE="A":PCE,PCE="O":PCE,1:"N") 42 . S STR=UNT_U_$P(NODE,U)_U_SRV_U_MED_U_CST_U_UNO_U_INACT_U_ASC_U_CAT 43 . S STR=STR_U_DFD_U_PCE,^TMP($J,"ECDSSUNT",CNT)=STR 44 S RESULTS=$NA(^TMP($J,"ECDSSUNT")) 45 Q 46 CAT(RESULTS,ECARY) ; 47 ; 48 ;This broker entry point returns a list of categories from file 726 49 ; RPC: EC GETCAT 50 ;INPUTS ECARY - Contains the following subscripted elements 51 ; STAT - Active or inactive category (optional) 52 ; A-ctive (default), I-nactive, B-oth 53 ; 54 ;OUTPUTS RESULTS - Array of category. Data pieces as follows:- 55 ; PIECE - Description 56 ; 1 IEN of Category 57 ; 2 Name of Category 58 ; 3 Creation Date 59 ; 4 Inactive Date 60 ; 61 N STAT,CNT,CAT,NODE,ECDT,INDT,CRDT 62 D SETENV^ECUMRPC 63 K ^TMP($J,"ECCAT") 64 S STAT=$P($G(ECARY),U),(CNT,CAT)=0 S:STAT="" STAT="A" 65 F S CAT=$O(^EC(726,CAT)) Q:'CAT S NODE=$G(^EC(726,CAT,0)) I NODE'="" D 66 . S ECDT=$P(NODE,U,3) 67 . I STAT="A",ECDT'="",ECDT'>DT Q 68 . I STAT="I",ECDT="" Q 69 . S CRDT=$$FMTE^XLFDT($P(NODE,U,2),"2F") 70 . S INDT=$$FMTE^XLFDT($P(NODE,U,3),"2F") 71 . ;S CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_CRDT_U_INDT 72 . S CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_$P(CRDT,"@",1)_U_$P(INDT,"@",1) 73 S RESULTS=$NA(^TMP($J,"ECCAT")) 74 Q 75 ; 76 CATCHK(RESULTS,ECARY) ; 77 ; 78 ;Broker call checks whether category is used in an Event Code Screen. 79 ; RPC: EC DSSCATCHECK 80 ;INPUTS ECARY - Contains the following subscripted elements 81 ; ECDA - DSS Unit ien (file #724) 82 ; 83 ;OUTPUTS RESULTS - Category used in Event Code Screen, 1-Yes or 0-No 84 ; 85 N ECDA,ECFLG,ECX 86 D SETENV^ECUMRPC 87 S ECDA=$P(ECARY,U) I ECDA="" Q 88 S (ECFLG,ECX)=0 89 F S ECX=$O(^ECJ("AP",ECX)) Q:'ECX!(ECFLG) D 90 . I $D(^ECJ("AP",ECX,ECDA)) S ECFLG=1 91 S RESULTS=ECFLG 92 Q 93 PXCHK(RESULTS,ECARY) ; 94 ; 95 ;Checks whether procedure description or national number exist 96 ;INPUTS ECARY - Contains the following subscripted elements 97 ; ECP - Procedure description 98 ; ECN - EC National Number 99 ; 100 ;OUTPUTS RESULTS - Px used^National # used, 1-Yes or 0-No ex. 1^0 101 ; 102 N ECX,ECP,ECN 103 Q:$G(ECARY) 104 D SETENV^ECUMRPC 105 S ECP=$P(ECARY,U),ECN=$P(ECARY,U,2),RESULTS="0^0" 106 I ECP'="",$D(^EC(725,"B",ECP)) S $P(RESULTS,U)=1 107 I ECN'="" F ECX="E","D","DL" D I $P(RESULTS,U,2) Q 108 . I $D(^EC(725,ECX,ECN)) S $P(RESULTS,U,2)=1 109 Q 110 SRCLST(RESULTS,ECARY) ; 111 ; 112 ;This broker entry returns an array of codes from a file based on a 113 ;search string. 114 ; RPC: EC GETLIST 115 ; 116 ;INPUTS ECARY - Contains the following subscripted elements 117 ; ECSTR - Search string 118 ; ECFIL - File to search 119 ; ECDIR - Search order 120 ; 121 ;OUTPUTS RESULTS - Array of values based on the search criteria. 122 ; 123 N ECNT,DIC,ECSTR,ECFIL,ECORD,ECER,ECDI 124 D SETENV^ECUMRPC 125 S ECNT=0,ECFIL=$P(ECARY,U),ECSTR=$P(ECARY,U,2),ECDIR=$P(ECARY,U,3) 126 S ECORD=$S(ECDIR=-1:"B",1:"I") 127 K ^TMP($J,"ECFIND"),^TMP("ECSRCH",$J) 128 I ECFIL="" Q 129 S ECNUM=44 130 I ECFIL=420.1 D CSTCTR ;Cost Center search 131 I ECFIL=49 D SERVC ;Service search 132 I ECFIL=723 D MEDSPC ;Medical specialty 133 I ECFIL=40.7 D STPCDE G EXIT ;Associated stop code 134 I ECFIL=724 D DUNT G EXIT ;DSS Unit 135 I ECFIL=726 D ECAT ;Category 136 I ECFIL=4 D LOC ;Location 137 I ECFIL=44 D ASCLN G EXIT ;Associated clinic 138 I ECFIL=757.01 D LEX^ECUMRPC2 G EXIT ;Lex ICD code 139 I ECFIL=200 D PROV^ECUMRPC2 ;Providers 140 I $D(ECER) S ^TMP($J,"ECFIND",1)="0^Error occurred during search" G EXIT 141 D SORT 142 EXIT K ^TMP("ECSRCH",$J) 143 S RESULTS=$NA(^TMP($J,"ECFIND")) 144 Q 145 ASCLN ;Search for active associated clinics (file #44) 146 N CNT,NOD,ECDT,INACT,REACT,ERR 147 S CNT=0,ECDT=DT 148 F Q:CNT=ECNUM S ECSTR=$O(^SC("B",ECSTR),ECDIR) Q:ECSTR="" S CLN="" D 149 .F S CLN=$O(^SC("B",ECSTR,CLN),ECDIR) Q:CLN="" S NOD=$G(^SC(CLN,0)) D 150 ..Q:NOD="" Q:$P(NOD,U,3)'="C" ;Q:+$G(^SC(CLN,"OOS")) 151 ..S ERR=0 I $D(^SC(CLN,"I")) D I ERR Q 152 ...S INACT=$P(^SC(CLN,"I"),U),REACT=$P(^SC(CLN,"I"),U,2) 153 ...I INACT D I ERR Q 154 ....I REACT="" S:ECDT'<INACT ERR=1 Q 155 ....I ECDT'<INACT,ECDT<REACT S ERR=1 Q 156 ...I REACT,ECDT<REACT S ERR=1 157 ..S CNT=CNT+1,^TMP($J,"ECFIND",CNT)=CLN_U_$P(NOD,U) 158 Q 159 CSTCTR ;Search for cost centers (File #420.1) 160 N ECNULL,INDX,STR,NSTR,I 161 S $P(ECNULL," ",7)=" ",INDX="B" 162 I $E(ECSTR)?.N,$L(ECSTR)<7 S ECSTR=ECSTR_$E(ECNULL,1,7-$L(ECSTR)) 163 I $L($P(ECSTR," "))=6,$P(ECSTR," ",2)?.A D ;truncate for x-ref 164 . S ECSTR=$P(ECSTR," ")_" "_$E($P(ECSTR," ",2,999),1,22) 165 I $E(ECSTR)?.A S INDX="C",(STR,NSTR)="" D S ECSTR=NSTR 166 .F I=1:1 S STR=$P(ECSTR," ",I) Q:STR="" D 167 ..S STR=$E(STR)_$TR($E(STR,2,9999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") 168 ..S NSTR=NSTR_STR 169 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"",INDX,"I '$P(^(0),U,2)","","^TMP(""ECSRCH"",$J)","ECER") 170 Q 171 SERVC ;Search for services (File #49) 172 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER") 173 Q 174 MEDSPC ;Search for medical specialty (File #723) 175 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER") 176 Q 177 STPCDE ;Search for associated stop code (File #40.7) 178 N ECNT,INDX,ECNUL,STR,IEN 179 S $P(ECNUL," ",30)=" ",INDX="B",ECNT=0,ECSTR=$P(ECSTR,"~") 180 I +ECSTR,+ECSTR?.N S INDX="C",IEN=0 D Q 181 .S ECSTR=$O(^DIC(40.7,INDX,+ECSTR)) I ECSTR="" Q 182 .F S IEN=$O(^DIC(40.7,INDX,ECSTR,IEN)) Q:'IEN D I ECNT>(ECNUM-1) Q 183 ..S STR=$G(^DIC(40.7,IEN,0)) I (STR="")!($P(STR,U,3)'="") Q 184 ..S STR=$E($P(STR,U),1,30)_" ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)_U_IEN 185 ..S ECNT=ECNT+1,^TMP($J,"ECFIND",ECNT)=STR 186 D LISTDIC(ECFIL,"",".01;1",ECORD,ECNUM,ECSTR,"",INDX,"I $P(^(0),""^"",3)=""""!($P(^(0),U,3)'<DT)","","^TMP(""ECSRCH"",$J)","ECER") 187 S ECNT=0 188 F S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT D 189 .S STR=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_$G(^(1)) 190 .S STR=$E($P(STR,U),1,30)_" ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2) 191 .S ^TMP($J,"ECFIND",ECNT)=STR_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT) 192 Q 193 DUNT ;Search for DSS unit (File #724) 194 N ECNT,SNDPCE 195 D LISTDIC(ECFIL,"",".01;10;13",ECORD,ECNUM,ECSTR,"","","I '$P(^(0),""^"",6),$P(^(0),U,8)","","^TMP(""ECSRCH"",$J)","ECER") 196 S ECNT=0 197 F S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT D 198 .S SNDPCE=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,13)) 199 .S SNDPCE=$S(SNDPCE="O":1,SNDPCE="A":1,1:0) 200 .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 201 Q 202 ECAT ;Search for Category (File #726) 203 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $P(^(0),""^"",3)=""""!($P(^(0),U,3)>DT)","","^TMP(""ECSRCH"",$J)","ECER") 204 Q 205 LOC ;Search for Location (File #4) 206 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $G(^(""EC""))","","^TMP(""ECSRCH"",$J)","ECER") 207 Q 208 LISTDIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER) ; 209 ;Produces a list of records in a file base on search string 210 N DIC 211 D LIST^DIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER) 212 K ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECID 213 Q 214 SORT ;Extracts data to be returned to broker 215 N ECNT,STR 216 S ECNT=0 217 F S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT D 218 .S ^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT) 219 Q 1 ECUMRPC1 ;ALB/JAM-Event Capture Management Broker Utilities ;28 Nov 00 2 ;;2.0; EVENT CAPTURE ;**25,30,33,72**;8 May 96 3 ; 4 DSSUNT(RESULTS,ECARY) ; 5 ; 6 ;This broker entry point returns DSS units from file 724 7 ; RPC: EC GETDSSUNIT 8 ;INPUTS ECARY - Contains the following subscripted elements 9 ; STAT - Active or inactive DSS Units (optional) 10 ; A-ctive (default), I-nactive, B-oth 11 ; 12 ;OUTPUTS RESULTS - Array of DSS units. Data pieces as follows:- 13 ; PIECE - Description 14 ; 1 IEN of DSS Unit 15 ; 2 Name of DSS Unit 16 ; 3 Service 17 ; 4 Medical Specialty 18 ; 5 Cost Center 19 ; 6 Unit Number 20 ; 7 Inactive Flag 21 ; 8 Associated Stop code (if not sending to PCE) 22 ; 9 Category flag 23 ; 10 Default date entry 24 ; 11 Send to PCE Flag 25 ; 26 N UNT,STAT,CNT,CAT,NODE,ECS,STR,SRV,MED,CST,UNO,INACT,ASC,PCE,ACT,NODE 27 N DFD 28 D SETENV^ECUMRPC 29 K ^TMP($J,"ECDSSUNT") 30 S STAT=$P($G(ECARY),U),(CNT,UNT)=0 S:STAT="" STAT="A" 31 F S UNT=$O(^ECD(UNT)) Q:'UNT S NODE=$G(^ECD(UNT,0)) I NODE'="" D 32 . S ECS=$P(NODE,U,8),ACT=$P(NODE,U,6),ACT=$S(ACT:1,1:0) 33 . Q:'ECS I $S(STAT="A"&(ACT):1,STAT="I"&('ACT):1,1:0) Q 34 . S CNT=CNT+1,CAT=$P(NODE,U,11),CAT=$S(CAT:"Y",1:"N"),UNO=$P(NODE,U,5) 35 . S SRV=$$GET1^DIQ(49,$P(NODE,U,2),.01,"I") 36 . S MED=$$GET1^DIQ(723,$P(NODE,U,3),.01,"I") 37 . S CST=$$GET1^DIQ(420.1,$P(NODE,U,4),.01,"I") 38 . S INACT=$P(NODE,U,6),INACT=$S(INACT:"I",1:"A"),ASC=$P(NODE,U,10) 39 . S:ASC ASC=$$GET1^DIQ(40.7,ASC,.01,"I") 40 . S DFD=$S($P(NODE,U,12)="N":"N",1:"X"),PCE=$P(NODE,U,14) 41 . S PCE=$S(PCE="A":PCE,PCE="O":PCE,1:"N") 42 . S STR=UNT_U_$P(NODE,U)_U_SRV_U_MED_U_CST_U_UNO_U_INACT_U_ASC_U_CAT 43 . S STR=STR_U_DFD_U_PCE,^TMP($J,"ECDSSUNT",CNT)=STR 44 S RESULTS=$NA(^TMP($J,"ECDSSUNT")) 45 Q 46 CAT(RESULTS,ECARY) ; 47 ; 48 ;This broker entry point returns a list of categories from file 726 49 ; RPC: EC GETCAT 50 ;INPUTS ECARY - Contains the following subscripted elements 51 ; STAT - Active or inactive category (optional) 52 ; A-ctive (default), I-nactive, B-oth 53 ; 54 ;OUTPUTS RESULTS - Array of category. Data pieces as follows:- 55 ; PIECE - Description 56 ; 1 IEN of Category 57 ; 2 Name of Category 58 ; 3 Creation Date 59 ; 4 Inactive Date 60 ; 61 N STAT,CNT,CAT,NODE,ECDT,INDT,CRDT 62 D SETENV^ECUMRPC 63 K ^TMP($J,"ECCAT") 64 S STAT=$P($G(ECARY),U),(CNT,CAT)=0 S:STAT="" STAT="A" 65 F S CAT=$O(^EC(726,CAT)) Q:'CAT S NODE=$G(^EC(726,CAT,0)) I NODE'="" D 66 . S ECDT=$P(NODE,U,3) 67 . I STAT="A",ECDT'="",ECDT'>DT Q 68 . I STAT="I",ECDT="" Q 69 . S CRDT=$$FMTE^XLFDT($P(NODE,U,2),"2F") 70 . S INDT=$$FMTE^XLFDT($P(NODE,U,3),"2F") 71 . S CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_CRDT_U_INDT 72 S RESULTS=$NA(^TMP($J,"ECCAT")) 73 Q 74 ; 75 CATCHK(RESULTS,ECARY) ; 76 ; 77 ;Broker call checks whether category is used in an Event Code Screen. 78 ; RPC: EC DSSCATCHECK 79 ;INPUTS ECARY - Contains the following subscripted elements 80 ; ECDA - DSS Unit ien (file #724) 81 ; 82 ;OUTPUTS RESULTS - Category used in Event Code Screen, 1-Yes or 0-No 83 ; 84 N ECDA,ECFLG,ECX 85 D SETENV^ECUMRPC 86 S ECDA=$P(ECARY,U) I ECDA="" Q 87 S (ECFLG,ECX)=0 88 F S ECX=$O(^ECJ("AP",ECX)) Q:'ECX!(ECFLG) D 89 . I $D(^ECJ("AP",ECX,ECDA)) S ECFLG=1 90 S RESULTS=ECFLG 91 Q 92 PXCHK(RESULTS,ECARY) ; 93 ; 94 ;Checks whether procedure description or national number exist 95 ;INPUTS ECARY - Contains the following subscripted elements 96 ; ECP - Procedure description 97 ; ECN - EC National Number 98 ; 99 ;OUTPUTS RESULTS - Px used^National # used, 1-Yes or 0-No ex. 1^0 100 ; 101 N ECX,ECP,ECN 102 Q:$G(ECARY) 103 D SETENV^ECUMRPC 104 S ECP=$P(ECARY,U),ECN=$P(ECARY,U,2),RESULTS="0^0" 105 I ECP'="",$D(^EC(725,"B",ECP)) S $P(RESULTS,U)=1 106 I ECN'="" F ECX="E","D","DL" D I $P(RESULTS,U,2) Q 107 . I $D(^EC(725,ECX,ECN)) S $P(RESULTS,U,2)=1 108 Q 109 SRCLST(RESULTS,ECARY) ; 110 ; 111 ;This broker entry returns an array of codes from a file based on a 112 ;search string. 113 ; RPC: EC GETLIST 114 ; 115 ;INPUTS ECARY - Contains the following subscripted elements 116 ; ECSTR - Search string 117 ; ECFIL - File to search 118 ; ECDIR - Search order 119 ; 120 ;OUTPUTS RESULTS - Array of values based on the search criteria. 121 ; 122 N ECNT,DIC,ECSTR,ECFIL,ECORD,ECER,ECDI 123 D SETENV^ECUMRPC 124 S ECNT=0,ECFIL=$P(ECARY,U),ECSTR=$P(ECARY,U,2),ECDIR=$P(ECARY,U,3) 125 S ECORD=$S(ECDIR=-1:"B",1:"I") 126 K ^TMP($J,"ECFIND"),^TMP("ECSRCH",$J) 127 I ECFIL="" Q 128 S ECNUM=44 129 I ECFIL=420.1 D CSTCTR ;Cost Center search 130 I ECFIL=49 D SERVC ;Service search 131 I ECFIL=723 D MEDSPC ;Medical specialty 132 I ECFIL=40.7 D STPCDE G EXIT ;Associated stop code 133 I ECFIL=724 D DUNT G EXIT ;DSS Unit 134 I ECFIL=726 D ECAT ;Category 135 I ECFIL=4 D LOC ;Location 136 I ECFIL=44 D ASCLN G EXIT ;Associated clinic 137 I ECFIL=757.01 D LEX^ECUMRPC2 G EXIT ;Lex ICD code 138 I ECFIL=200 D PROV^ECUMRPC2 ;Providers 139 I $D(ECER) S ^TMP($J,"ECFIND",1)="0^Error occurred during search" G EXIT 140 D SORT 141 EXIT K ^TMP("ECSRCH",$J) 142 S RESULTS=$NA(^TMP($J,"ECFIND")) 143 Q 144 ASCLN ;Search for active associated clinics (file #44) 145 N CNT,NOD,ECDT,INACT,REACT,ERR 146 S CNT=0,ECDT=DT 147 F Q:CNT=ECNUM S ECSTR=$O(^SC("B",ECSTR),ECDIR) Q:ECSTR="" S CLN="" D 148 .F S CLN=$O(^SC("B",ECSTR,CLN),ECDIR) Q:CLN="" S NOD=$G(^SC(CLN,0)) D 149 ..Q:NOD="" Q:$P(NOD,U,3)'="C" ;Q:+$G(^SC(CLN,"OOS")) 150 ..S ERR=0 I $D(^SC(CLN,"I")) D I ERR Q 151 ...S INACT=$P(^SC(CLN,"I"),U),REACT=$P(^SC(CLN,"I"),U,2) 152 ...I INACT D I ERR Q 153 ....I REACT="" S:ECDT'<INACT ERR=1 Q 154 ....I ECDT'<INACT,ECDT<REACT S ERR=1 Q 155 ...I REACT,ECDT<REACT S ERR=1 156 ..S CNT=CNT+1,^TMP($J,"ECFIND",CNT)=CLN_U_$P(NOD,U) 157 Q 158 CSTCTR ;Search for cost centers (File #420.1) 159 N ECNULL,INDX,STR,NSTR,I 160 S $P(ECNULL," ",7)=" ",INDX="B" 161 I $E(ECSTR)?.N,$L(ECSTR)<7 S ECSTR=ECSTR_$E(ECNULL,1,7-$L(ECSTR)) 162 I $L($P(ECSTR," "))=6,$P(ECSTR," ",2)?.A D ;truncate for x-ref 163 . S ECSTR=$P(ECSTR," ")_" "_$E($P(ECSTR," ",2,999),1,22) 164 I $E(ECSTR)?.A S INDX="C",(STR,NSTR)="" D S ECSTR=NSTR 165 .F I=1:1 S STR=$P(ECSTR," ",I) Q:STR="" D 166 ..S STR=$E(STR)_$TR($E(STR,2,9999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") 167 ..S NSTR=NSTR_STR 168 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"",INDX,"I '$P(^(0),U,2)","","^TMP(""ECSRCH"",$J)","ECER") 169 Q 170 SERVC ;Search for services (File #49) 171 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER") 172 Q 173 MEDSPC ;Search for medical specialty (File #723) 174 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER") 175 Q 176 STPCDE ;Search for associated stop code (File #40.7) 177 N ECNT,INDX,ECNUL,STR,IEN 178 S $P(ECNUL," ",30)=" ",INDX="B",ECNT=0,ECSTR=$P(ECSTR,"~") 179 I +ECSTR,+ECSTR?.N S INDX="C",IEN=0 D Q 180 .S ECSTR=$O(^DIC(40.7,INDX,+ECSTR)) I ECSTR="" Q 181 .F S IEN=$O(^DIC(40.7,INDX,ECSTR,IEN)) Q:'IEN D I ECNT>(ECNUM-1) Q 182 ..S STR=$G(^DIC(40.7,IEN,0)) I (STR="")!($P(STR,U,3)'="") Q 183 ..S STR=$E($P(STR,U),1,30)_" ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)_U_IEN 184 ..S ECNT=ECNT+1,^TMP($J,"ECFIND",ECNT)=STR 185 D LISTDIC(ECFIL,"",".01;1",ECORD,ECNUM,ECSTR,"",INDX,"I $P(^(0),""^"",3)=""""!($P(^(0),U,3)'<DT)","","^TMP(""ECSRCH"",$J)","ECER") 186 S ECNT=0 187 F S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT D 188 .S STR=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_$G(^(1)) 189 .S STR=$E($P(STR,U),1,30)_" ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2) 190 .S ^TMP($J,"ECFIND",ECNT)=STR_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT) 191 Q 192 DUNT ;Search for DSS unit (File #724) 193 N ECNT,SNDPCE 194 D LISTDIC(ECFIL,"",".01;10;13",ECORD,ECNUM,ECSTR,"","","I '$P(^(0),""^"",6),$P(^(0),U,8)","","^TMP(""ECSRCH"",$J)","ECER") 195 S ECNT=0 196 F S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT D 197 .S SNDPCE=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,13)) 198 .S SNDPCE=$S(SNDPCE="O":1,SNDPCE="A":1,1:0) 199 .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 200 Q 201 ECAT ;Search for Category (File #726) 202 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $P(^(0),""^"",3)=""""!($P(^(0),U,3)>DT)","","^TMP(""ECSRCH"",$J)","ECER") 203 Q 204 LOC ;Search for Location (File #4) 205 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $G(^(""EC""))","","^TMP(""ECSRCH"",$J)","ECER") 206 Q 207 LISTDIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER) ; 208 ;Produces a list of records in a file base on search string 209 N DIC 210 D LIST^DIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER) 211 K ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECID 212 Q 213 SORT ;Extracts data to be returned to broker 214 N ECNT,STR 215 S ECNT=0 216 F S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT D 217 .S ^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT) 218 Q
Note:
See TracChangeset
for help on using the changeset viewer.
