source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECUMRPC1.m@ 1495

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1ECUMRPC1 ;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 ;
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 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 ;
76CATCHK(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
93PXCHK(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
110SRCLST(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
142EXIT K ^TMP("ECSRCH",$J)
143 S RESULTS=$NA(^TMP($J,"ECFIND"))
144 Q
145ASCLN ;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
159CSTCTR ;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
171SERVC ;Search for services (File #49)
172 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
173 Q
174MEDSPC ;Search for medical specialty (File #723)
175 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
176 Q
177STPCDE ;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
193DUNT ;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
202ECAT ;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
205LOC ;Search for Location (File #4)
206 D LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $G(^(""EC""))","","^TMP(""ECSRCH"",$J)","ECER")
207 Q
208LISTDIC(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
214SORT ;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
Note: See TracBrowser for help on using the repository browser.