| 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
|
|---|
