- 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 Jan 18, 2025@03:00:19 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