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