close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC1.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC1.m@ 1073

Last change on this file since 1073 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 8.8 KB
RevLine 
1ECUMRPC1 ;ALB/JAM-Event Capture Management Broker Utilities ;28 Nov 00
2 ;;2.0; EVENT CAPTURE ;**25,30,33,72**;8 May 96
3 ;
4DSSUNT(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
46CAT(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 ;
75CATCHK(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
92PXCHK(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
109SRCLST(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
141EXIT K ^TMP("ECSRCH",$J)
142 S RESULTS=$NA(^TMP($J,"ECFIND"))
143 Q
144ASCLN ;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
158CSTCTR ;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
170SERVC ;Search for services (File #49)
171 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
172 Q
173MEDSPC ;Search for medical specialty (File #723)
174 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
175 Q
176STPCDE ;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
192DUNT ;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
201ECAT ;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
204LOC ;Search for Location (File #4)
205 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $G(^(""EC""))","","^TMP(""ECSRCH"",$J)","ECER")
206 Q
207LISTDIC(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
213SORT ;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 TracBrowser for help on using the repository browser.