ECUMRPC ;ALB/JAM;Event Capture Management Broker Utilities ;2/9/18  13:58
 ;;2.0;EVENT CAPTURE;**25,32,33,131,139**;8 May 96;Build 7
ECUSR(RESULTS,ECARY) ;
 ;
 ;This broker entry point returns an array of users with access to a 
 ;DSS unit in file 200.
 ;        RPC: EC GETDSSUNITUSRS
 ;INPUTS         ECARY - Contains the following subscripted elements
 ;               UNT   - DSS unit IEN
 ;
 ;OUTPUTS        RESULTS - The array of users. Data pieces as follows:-
 ;               PIECE - Description
 ;                 1     NAME of user
 ;                 2     DUZ or IEN of file 200
 ;
 
UNT,EDUZ,CNT
 
SETENV
 
UNT=$P(ECARY,UQ:UNT=""
 
^TMP($J,"ECUSR"(EDUZ,CNT)=0
 
F  S EDUZ=$O(^VA(200,EDUZ)) Q:'EDUZ  I $D(^VA(200,EDUZ,"EC",UNT,0)) D
 
CNT=CNT+1,^TMP($J,"ECUSR",CNT)=$P(^VA(200,EDUZ,0),U)_U_EDUZ
 
RESULTS=$NA(^TMP($J,"ECUSR"))
 
Q
 
;
ECLOC(RESULTS) ;
 ;
 ;This broker entry point returns all active Event Capture locations
 ;        RPC: EC GETECLOC
 ;
 ;OUTPUTS        RESULTS - The array of active Event Capture locations.
 ;               PIECE - Description
 ;                 1     Location description
 ;                 2     LOC IEN
 
LOC
 
SETENV
 
^TMP($J,"ECLOC")
 
GETLOC^ECL(.LOC^TMP($J,"ECLOC")=LOC
 
RESULTS=$NA(^TMP($J,"ECLOC"))
 
Q
ECSCN(RESULTS,ECARY) ;
 ;
 ;Broker call returns the entries from EC EVENT CODE SCREENS FILE #720.3
 ;        RPC: GETECSCREEN
 ;INPUTS   ECARY   - Contains the following subscripted elements
 ;          STAT   - Active or inactive Event Code Screens
 ;                   A-ctive (default), I-nactive, B-oth
 ;          LOCIEN - Location IEN (optional)
 ;          DSSIEN - DSS IEN (optional)
 ;
 ;OUTPUTS  RESULTS - Array of EC screens, contains
 ;          720.3 ien^location description^DSS Unit description^Category
 ;          desription^Procedure 5 digit code and description
 ;
 
STAT,IEN,CNT,ACT,FL,V,EI,ECSCR,CLN,LOC,UNT,CAT,PX,NODE,LOCIEN,DSSIEN
 
SETENV ^TMP($J,"ECSCN")
 
STAT=$P($G(ECARY,"A"),U),LOCIEN=$P($G(ECARY),U,2),FL="4,724,726"
 
V="LOC,UNT,CAT",(IEN,CNT)=0,DSSIEN=$P(ECARY,U,3)
 
F  S IEN=$O(^ECJ(IEN)) Q:'IEN  NODE=$G(^ECJ(IEN,0)) NODE'="" D
 
.ACT=$P(NODE,U,2),ECSCR=$TR($P(NODE,U),"-;,","^^")
 .
I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q
 
.LOCIEN'="",LOCIEN'=$P(ECSCR,UQ
 
.DSSIEN'="",DSSIEN'=$P(ECSCR,U,2) Q
 
.EI=1:1:3 D
 
..@$P(V,",",EI)=$$GET1^DIQ($P(FL,",",EI),$P(ECSCR,U,EI),.01,"E"),PX=""
 
.I $P(ECSCR,U,5)["EC" D
 
..PRO=$G(^EC(725,$P(ECSCR,U,4),0)),PX=$P(PRO,U,2)_" "_$P(PRO,U)
 .
E  S PRO=$$CPT^ICPTCOD($P(ECSCR,U,4)) PX=$P(PRO,U,2)_" "_$P(PRO,U,3)
 .
CNT=CNT+1,^TMP($J,"ECSCN",CNT)=IEN_U_LOC_U_UNT_U_CAT_U_PX
 
RESULTS=$NA(^TMP($J,"ECSCN"))
 
Q
ECSDTLS(RESULTS,ECARY) ;
 ;
 ;Broker call returns details on an Event Code Screen from EC EVENT 
 ;CODE SCREENS FILE #720.3
 ;        RPC: GETECSDETAIL
 ;INPUTS   ECARY  - Contains the following data
 ;                   Event code screen IEN
 ;
 ;OUTPUTS  RESULTS - Details of EC screen, contains
 ;          720.3 ien^event code screen key^synonym^volume^associated 
 ;          clinic^Procedure reason indicator^event code screen status
 ;          flag (y-active,n-inactive)^Send To PCE
 ;
 
NODE,PRO,CLN,STAT,STR,SPCE
 
Q:$G(ECARY)=""  Q:'$D(^ECJ(ECARY,0))
 
SETENV
 
NODE=^ECJ(ECARY,0),PRO=$G(^ECJ(ECARY,"PRO")),SPCE=$P(NODE,"-",2)
 
SPCE=$P($G(^ECD(SPCE,0)),U,14),SPCE=$S(SPCE="A":1,1:0) ;139 Modified $S logic to set SPCE to 1 if "A" and 0 for all others.  Value is used to determine if clinic is asked for as a choice
 
STAT=$S($P(NODE,U,2)="":"Y",1:"N")
 
S:$P(PRO,U,4)'="" CLN=$$GET1^DIQ(44,$P(PRO,U,4),.01,"E")
 
STR=ECARY_U_$P(NODE,U)_U_$P(PRO,U,2,3)_U_$G(CLN)_U_$P(PRO,U,5)_U_STAT
 
RESULTS=STR_U_SPCE
 
Q
 
;
DSSECS(RESULTS,ECARY) ;
 ;
 ;Broker call returns a list of Event Code Screen from EC EVENT CODE
 ;SCREENS FILE #720.3 based on a DSS Unit
 ;        RPC: EC GETDSSECS
 ;INPUTS   ECARY  - Contains the following data
 ;          ECD   - DSS Unit IEN
 ;          ECL   - Location
 ;
 ;OUTPUTS  RESULTS - Data on EC screen, contains
 ;          720.3 ien^Procedure 5 digit code and description^Location^
 ;          status(Y-active, N-inactive)^Category description^synonym
 ;
 
NODE,PRO,STAT,CNT,ECD,LOC,CAT,IEN,PX,PN,CATD,LOCDS,ECL,ECSYN
 
ECD=$P(ECARY,U),ECL=$P(ECARY,U,2) ECD="",ECL="" Q
 D 
SETENV ^TMP($J,"ECDSSECS")
 
(CNT,LOC)=0 ECL'="" LOC=ECL-1
 
F  S LOC=$O(^ECJ("AP",LOC)) Q:'LOC  CAT=""  Q:ECL&(ECL'=LOC)  D
 
.ECD'="" D:$D(^ECJ("AP",LOC,ECD)) GETSCN 
 
.ECD=0 F  S ECD=$O(^ECJ("AP",LOC,ECD)) Q:'ECD  GETSCN
 
RESULTS=$NA(^TMP($J,"ECDSSECS"))
 
Q
GETSCN F  S CAT=$O(^ECJ("AP",LOC,ECD,CAT)) Q:CAT=""  PX="" D
 
.CAT,'$P(^ECD(ECD,0),U,11) Q  ;131 Don't show screen if it has a category and the DSS Unit is set to "no categories"
 
.F  S PX=$O(^ECJ("AP",LOC,ECD,CAT,PX)) Q:PX=""  IEN=0 D
 
..F  S IEN=$O(^ECJ("AP",LOC,ECD,CAT,PX,IEN)) Q:'IEN  D
 
...NODE=$G(^ECJ(IEN,0)) NODE="" Q
 
...PRO=$G(^ECJ(IEN,"PRO")),ECSYN=$P(PRO,U,2),PN=$P($P(PRO,U),";")
 ...
PN="" Q
 
...I $P(PRO,U)["EC" PN=$G(^EC(725,PN,0)),PRO=$P(PN,U,2)_" "_$P(PN,U)
 ...
E  S PN=$$CPT^ICPTCOD(PNPRO=$P(PN,U,2)_" "_$P(PN,U,3)
 ...
STAT=$S($P(NODE,U,2)'="":"No",1:"Yes")
 ...
CATD=$S('CAT:"None",1:$P($G(^EC(726,CAT,0)),U))
 ...
LOCDS=$$GET1^DIQ(4,LOC,.01,"I"),CNT=CNT+1
 ...
^TMP($J,"ECDSSECS",CNT)=IEN_U_PRO_U_LOCDS_U_STAT_U_CATD_U_ECSYN
 
Q
 
;
ECPXRS(RESULTS,ECARY) ;
 ;
 ;Broker call returns entries for Procedure reasons linked to EC screen.
 ;        RPC: EC GETPXREASON
 ;INPUTS   ECARY  - Contains the following subscripted elements
 ;          ECSCR - Event code screen ien (file #720.3)
 ;
 ;OUTPUTS  RESULTS - Array of procedure reasons for EC screen
 ;          Procedure reason^procedure reason ien #720.4^Event Code 
 ;          screens/procedure reason link ien #720.5
 ;
 
RSN,IEN,CNT,RIEN
 
ECSCR=$G(ECARY,""ECSCR="" Q
 D 
SETENV
 
^TMP($J,"ECPXREAS"(IEN,CNT)=0
 
F  S IEN=$O(^ECL("AD",ECSCR,IEN)) Q:'IEN  D
 
RSN=$G(^ECR(IEN,0)),RIEN=$O(^ECL("AD",ECSCR,IEN,0)) Q:'$P(RSN,U,2)
 . 
CNT=CNT+1,^TMP($J,"ECPXREAS",CNT)=$P(RSN,U)_U_IEN_U_RIEN
 
RESULTS=$NA(^TMP($J,"ECPXREAS"))
 
Q
 
;
ECNATPX(RESULTS,ECARY) ;
 ;
 ;Broker call returns EC national & local  Procedures from file #725.
 ;        RPC: EC GETNATPX
 ;INPUTS   ECARY  - Contains the following subscripted elements
 ;          ECPX - Procedures to output, L- local, N- National, B- Both
 ;          STAT - Active or inactive EC Nat Codes
 ;                 A-ctive (default), I-nactive, B-oth
 ;
 ;OUTPUTS  RESULTS - Array of EC local procedures
 ;          ien #725^Procedure name^national number^inactive date^
 ;          synonym^CPT ien^CPT code^CPT Short Name
 ;
 
STAT,IEN,STR,CNT,ACT,CPT,CPTDAT,ECPX
 
SETENV
 
ECPX=$P(ECARY,U),STAT=$P(ECARY,U,2)
 
S:ECPX="" ECPX="L" S:STAT="" STAT="A"
 
^TMP($J,"ECLOCPX")
 
IEN=$S(ECPX="L":90000,1:0),CNT=0
 
F  S IEN=$O(^EC(725,IEN)) Q:'IEN!((ECPX="N")&(IEN>90000))  D
 
STR=$G(^EC(725,IEN,0)) STR="" Q
 
ACT=$P(STR,U,3),CPT=$P(STR,U,5)
 . 
I $S(STAT="A"&(ACT'=""):1,STAT="I"&(ACT=""):1,1:0) Q
 
CPTDAT=$S(CPT="":"",1:$$CPT^ICPTCOD(CPT))
 . 
CNT=CNT+1,^TMP($J,"ECLOCPX",CNT)=IEN_U_STR_U_$P(CPTDAT,U,2,3)
 
RESULTS=$NA(^TMP($J,"ECLOCPX"))
 
Q
SETENV ;set environment variables for RPC broker
 
'$G(DUZD
 
DUZ=.5,DUZ(0)="@",U="^",DTIME=300
 . 
NOW^%DTC DT=X
 
Q