ECUERPC ;ALB/JAM - Event Capture Data Entry Broker Utilities ;1/25/18 12:38
;;2.0;EVENT CAPTURE;**25,32,33,46,47,59,72,95,114,126,129,131,139**;8 May 96;Build 7
;
; Reference to $$SINFO^ICDEX supported by ICR #5747
; Reference to $$ICDDX^ICDEX supported by ICR5747
;
USRUNT(RESULTS,ECARY) ;
;This broker call returns an array of DSS units for a user & location
; RPC: EC GETUSRDSSUNIT
;INPUTS ECARY - Contains the following delimited elements
; 1. ECL - Location IEN (if define gives User's DSS
; units for a location)
; 2. ECDUZ - New Person IEN (if define gives list of
; DSS Units available to user)
; 3. ECSUMUSR - Indicates which report is requesting this
; list. (optional)
; 4. ECDUST - Indicates DSS unit status requested (A)ctive
; (I)nactive or (B)oth. (optional)
;
;OUTPUTS RESULTS - Array of DSS Units. Data pieces as follows:-
; PIECE - Description
; 1 IEN of file 724
; 2 Name of DSS Unit
; 3 Send to PCE Flag
; 4 Data Entry Date/Time Default
N ECL,ECDUZ,CNT,STR,DPT,IEN,ECSUMUSR,ECDUST ;139
D SETENV^ECUMRPC
S ECL=$P(ECARY,U),ECDUZ=$P(ECARY,U,2) I ECL="",ECDUZ="" Q
S ECSUMUSR=$P(ECARY,U,3),ECDUST=$P(ECARY,U,4) S:ECDUST="" ECDUST="B" ;139
K ^TMP($J,"ECUSRUNT") S (DPT,CNT)=0
I ECL'="",ECDUZ="" S ECDUZ=$G(DUZ,U) I ECDUZ="" Q
I $G(ECSUMUSR)="ECSUM" D ECSUM S RESULTS=$NA(^TMP($J,"ECUSRUNT")) Q ;139 Add special branch for the ECSUM report
I $D(^XUSEC("ECALLU",ECDUZ)) S DPT="" D
.I ECL="" S ^TMP($J,"ECUSRUNT",CNT+1)="ALL^ALL" Q
.I ECL="ALL" S ECL=""
.F S DPT=$O(^ECD("B",DPT)) Q:DPT="" S IEN=0 D
..F S IEN=$O(^ECD("B",DPT,IEN)) Q:'IEN D UNTCHK
E D
.I ECL="ALL" S ECL=""
.F S DPT=$O(^VA(200,ECDUZ,"EC",DPT)) Q:'DPT S IEN=DPT D UNTCHK
S RESULTS=$NA(^TMP($J,"ECUSRUNT"))
Q
UNTCHK ;Check if DSS unit exist as event code screen and if active
N DSSF,DFD
;I '$D(^ECJ("AP",ECL,IEN))!($P($G(^ECD(IEN,0)),U,6)) Q
I ECL'="",'$D(^ECJ("AP",ECL,IEN)) Q
I ($P($G(^ECD(IEN,0)),U,6))!('$P($G(^ECD(IEN,0)),U,8)) Q
;Check if event code screens associated with DSS unit are active
I ECL'="",'$$ECSCHK(ECL,IEN) Q
S DSSF=$P(^ECD(IEN,0),"^",14) S:DSSF="" DSSF="N"
S DFD=$S($P(^ECD(IEN,0),"^",12)="N":"N",1:"X") ; added by VMP
S CNT=CNT+1,STR=IEN_"^"_$P(^ECD(IEN,0),"^")_U_DSSF_"^"_DFD
S ^TMP($J,"ECUSRUNT",CNT)=STR
Q
ECSCHK(ECL,ECIEN) ;Check if any event code screens associated with DSS unit are active; EC*129
N ECAT,ECPRX,ECS,ECNODE,ECFLG
S ECAT="",ECFLG=0
F S ECAT=$O(^ECJ("AP",ECL,ECIEN,ECAT)) Q:ECAT="" D Q:ECFLG
.S ECPRX="" F S ECPRX=$O(^ECJ("AP",ECL,ECIEN,ECAT,ECPRX)) Q:ECPRX="" D Q:ECFLG
..S ECS=0 F S ECS=$O(^ECJ("AP",ECL,ECIEN,ECAT,ECPRX,ECS)) Q:'ECS D Q:ECFLG
...S ECNODE=$G(^ECJ(ECS,0)) I $P(ECNODE,"^",2)="" S ECFLG=1
Q ECFLG
;
ECSUM ;139 Section added to allow for sorting DSS units by status
N DSSIEN,DSSNAME,NODE,STAT,DSSF,DFO,STR
S DSSNAME="" F S DSSNAME=$O(^ECD("B",DSSNAME)) Q:DSSNAME="" S DSSIEN=0 F S DSSIEN=$O(^ECD("B",DSSNAME,DSSIEN)) Q:'+DSSIEN D
.S NODE=$G(^ECD(DSSIEN,0)) Q:NODE=""
.I '$P(NODE,U,8) Q ;DSS Unit not for use in Event Capture
.S STAT=$S($P(NODE,U,6):"I",1:"A") ;DSS Unit status
.I ECDUST'="B",STAT'=ECDUST Q ;If not getting both active and inactive units, quit if unit status isn't what we're looking for
.I ECL'="ALL",'$D(^ECJ("AP",ECL,DSSIEN)) Q ;For all locations, no need to check for event code screens. For single location, DSS unit must have at least one event code screen
.S DSSF=$P(NODE,U,14) S:DSSF="" DSSF="N" ;Send to PCE setting
.S DFD=$S($P(NODE,U,12)="N":"N",1:"X") ;Unit's default date/time setting
.S CNT=CNT+1,STR=DSSIEN_U_$P(NODE,U)_U_DSSF_U_DFD
.S ^TMP($J,"ECUSRUNT",CNT)=STR
Q
;
CAT(RESULTS,ECARY) ;
;This broker entry point returns an array of categories for an Event
;Code screen based on location and DSS unit.
; RPC: EC GETECSCATS
;INPUTS ECARY - Contains the following values separated by "^"
; ECL - Location IEN
; ECD - DSS Unit IEN
; ECCSTA-Active or inactive category
; A-ctive (default), I-nactive, B-oth
;
;OUTPUTS RESULTS - Array of categories. Data pieces as follows:-
; PIECE - Description
; 1 - Category IEN
; 2 - Category description
;
N ECL,ECD,ECC,CNT,DATA,ECCSTA
D SETENV^ECUMRPC
S ECL=$P(ECARY,U),ECD=$P(ECARY,U,2) I (ECL="")!(ECD="") Q
S ECCSTA=$P(ECARY,U,3)
K ^TMP($J,"ECSCATS")
D CATS^ECHECK1
M ^TMP($J,"ECSCATS")=ECC
S RESULTS=$NA(^TMP($J,"ECSCATS"))
Q
PROC(RESULTS,ECARY) ;
;This broker entry point returns an array of procedures for an Event
;Code screen (file #720.3) based on location, DSS unit, and Category
; RPC: EC GETECSPROCS
;INPUTS ECARY - Contains the following values separated by "^"
; ECL - Location IEN
; ECD - DSS Unit IEN
; ECC - Category IEN
; ECDT - Procedure Date
;
;OUTPUTS RESULTS - Array of procedures. Data pieces as follows:-
; PIECE - Description
; 1 - EC National Number SPACE Procedure Name SPACE
; - [Synonym]
; 2 - Procedure Code
; 3 - CPT Code
; 4 - Default volume (1 if no default volume)
; 5 - Event code screen IEN
;
N ECL,ECD,ECC,CNT,DATA,STR,ECCPT,PX,NAME,NUM ;126
D SETENV^ECUMRPC
S ECL=$P(ECARY,U),ECD=$P(ECARY,U,2),ECC=$P(ECARY,U,3)
I (ECL="")!(ECD="") Q
S:$P($G(^ECD(ECD,0)),U,11)=0 ECC="" S:ECC="" ECC=0 ;131
S ECDT=$P(ECARY,U,4)
K ^TMP($J,"ECPRO")
D PROS^ECHECK1
S CNT=1,NAME="" F S NAME=$O(^TMP("ECPRO",$J,"N2",NAME)) Q:NAME="" S NUM=$O(^TMP("ECPRO",$J,"N2",NAME,0)) D ;126
.S DATA=^TMP("ECPRO",$J,NUM),PX=$P(DATA,U) ;126
.S ECCPT=$S(PX["EC":$P($G(^EC(725,+PX,0)),"^",5),1:+PX)
.S STR=$P(DATA,U,5)_" "_$P(DATA,U,4)_" ["_$P(DATA,U,3)_"]"_U_PX
.S STR=STR_U_ECCPT_U_$S($P(DATA,U,6):+$P(DATA,U,6),1:1)_U_$P(DATA,U,2)
.S ^TMP($J,"ECPRO",CNT)=STR,CNT=CNT+1 ;126
S RESULTS=$NA(^TMP($J,"ECPRO"))
K ^TMP("ECPRO",$J)
Q
ECPXMOD(RESULTS,ECARY) ;
;Broker call returns modifier entries for a CPT Procedure
; RPC: EC GETPXMODIFIER
;INPUTS ECARY - Contains the following values separated by "^"
; ECCPT - CPT code ien (file #81)
; ECDT - Procedure date and time (fileman format)
;
;OUTPUTS RESULTS - Array of procedure modifiers
; 2-character modifier^modifer name^modifier ien #81.3
;
N CNT,SUB,ECCPT,ECDT,DATA,ECMOD
D SETENV^ECUMRPC
S ECCPT=$P(ECARY,U),ECDT=$P(ECARY,U,2) I ECDT="" D NOW^%DTC S ECDT=%
I ECCPT="" Q
K ^TMP($J,"ECPXMODS") S (SUB,CNT)=0
S DATA=$$CODM^ICPTCOD(ECCPT,"ECMOD","",ECDT) I +DATA<0 Q
F S SUB=$O(ECMOD(SUB)) Q:SUB="" I $P(ECMOD(SUB),U,2)'="" D
. I +$$MODP^ICPTMOD(ECCPT,$P(ECMOD(SUB),U,2),"I",ECDT)>0 D
. . S CNT=CNT+1,^TMP($J,"ECPXMODS",CNT)=SUB_U_ECMOD(SUB)
S RESULTS=$NA(^TMP($J,"ECPXMODS"))
Q
PRVDER(RESULTS,ECARY) ;
;remove this rpc before release;JAM 6/4/01
;This broker entry point returns an array of valid providers
; RPC: EC GETPROVIDER
;INPUTS ECARY - Contains the following subscripted elements
; ECDT - Procedure date
;
;OUTPUTS RESULTS - Array of providers. Data pieces as follows:-
; PIECE - Description
; IEN of file 200^Provider Name^occupation^specialty^
; subspecialty
;
N IEN,CNT,ECUTN,KEY,USR
D SETENV^ECUMRPC
S ECDT=$P($G(ECARY),U),ECDT=$S(ECDT="":DT,1:ECDT)
K ^TMP($J,"ECPRVDRS") S CNT=0
F KEY="PROVIDER" S IEN=0 D
.F S IEN=$O(^XUSEC(KEY,IEN)) Q:'IEN S USR=$G(^VA(200,IEN,0)) D:USR'=""
..S ECUTN=$$GET^XUA4A72(IEN,ECDT) I +ECUTN'>0 Q
..S CNT=CNT+1,^TMP($J,"ECPRVDRS",CNT)=IEN_U_$P(USR,U)_U_$P(ECUTN,2,4)
S RESULTS=$NA(^TMP($J,"ECPRVDRS"))
Q
;
ELIG(RESULTS,ECARY) ;
;
;Broker call returns a list of patient eligibilities
; RPC: EC GETPATELIG
;INPUTS ECARY - Contains the following subscripted elements
; DFN - Patient ien (file #2)
;
;OUTPUTS RESULTS - Array of eligibilities
; primary/secondary elig flag^elig ien^elig description
;
N CNT,SUB,DFN,VAEL
D SETENV^ECUMRPC
S DFN=$P(ECARY,U) I DFN="" Q
K ^TMP($J,"ECPATELIG")
D ELIG^VADPT I $G(VAEL(1))="" Q
S ^TMP($J,"ECPATELIG",1)="1^"_VAEL(1),SUB=0,CNT=1
F S SUB=$O(VAEL(1,SUB)) Q:SUB="" D
. S CNT=CNT+1,^TMP($J,"ECPATELIG",CNT)="0^"_VAEL(1,SUB)
S RESULTS=$NA(^TMP($J,"ECPATELIG"))
Q
PRDEFS(RESULTS,ECARY) ;
;This broker entry point returns the defaults for procedure data entry
; RPC: EC GETPRODEFS
;INPUTS ECARY - Contains the following values separated by "^"
; ECL - Location IEN
; ECD - DSS Unit IEN
; ECC - Category IEN
;
;OUTPUTS RESULTS - Data pieces as follows:-
; PIECE - Description
; 1 - Associated Clinic IEN
; 2 - Associated Clinic
; 3 - Medical Specialty IEN
; 4 - Medical Specialty
;
N ECL,ECD,ECC,ECP,IEN,ASC,ASCNM,MEDSP,MEDSPNM,ECCH
D SETENV^ECUMRPC
S ECL=$P(ECARY,U),ECD=$P(ECARY,U,2),ECC=$P(ECARY,U,3),ECP=$P(ECARY,U,4)
S:ECC="" ECC=0 I (ECL="")!(ECD="") Q
S (ASCNM,MEDSPNM)="",ECCH=ECL_"-"_ECD_"-"_ECC_"-"_ECP
I '$D(^ECJ("B",ECCH)) Q
S IEN=$O(^ECJ("B",ECCH,0)) I IEN="" Q
S ASC=$P($G(^ECJ(IEN,"PRO")),U,4) I ASC D
.S ASCNM=$$GET1^DIQ(44,ASC,.01,"I")
S MEDSP=$P($G(^ECD(ECD,0)),U,3) I MEDSP D
.S MEDSPNM=$$GET1^DIQ(723,MEDSP,.01,"I")
S RESULTS=ASC_U_ASCNM_U_MEDSP_U_MEDSPNM
Q
PATPROC(RESULTS,ECARY) ;
;
;Broker call returns the entries from EVENT CAPTURE PATIENT FILE #721
;
;RPC: EC GETPATPROCS
;
;INPUTS ECARY - Contains the following values separated by "^"
; ECLOC - Location ien
; ECPAT - Patient DFN ien
; ECUNT - DSS unit ien
; ECSD - Start Date
; ECED - End Date
;
;OUTPUTS RESULTS - Array of Event Capture Patient entries contain
; 721 IEN^Procedure date/time^Category^Procedure^Volume^
; Provider^ordering section^associated clinic^
; (ICD Coding system) primary dx code primary dx code description
; ^Provider IEN
;
N IEN,CNT,ECCS,ECV,ECLOC,ECUNT,ECPAT,PX,NODE,DATA,PDT,PDX,PND,PDXD,CAT,ECI
N ORS,PRV,PRO,PROV,ECU
D SETENV^ECUMRPC ;set environment variables for RPC broker
S ECV="ECLOC^ECPAT^ECUNT^ECSD^ECED"
D PARSE(ECV,ECARY) I (ECLOC="")!(ECPAT="")!(ECUNT="") Q
K ^TMP($J,"ECPATPX")
S ECSD=$G(ECSD,DT),ECED=$G(ECED,DT)
S %DT="X" F ECI="ECSD","ECED" S X=@ECI D ^%DT S @ECI=Y
K X,Y
S ECSD=$S(ECSD=-1:DT,1:ECSD)-.0001,ECED=$S(ECED=-1:DT,1:ECED)+.9999
Q:ECED'>ECSD S PDT=ECSD,CNT=0
F S PDT=$O(^ECH("ADT",ECLOC,ECPAT,ECUNT,PDT)) Q:'PDT!(PDT>ECED) D
. S IEN=0 F S IEN=$O(^ECH("ADT",ECLOC,ECPAT,ECUNT,PDT,IEN)) Q:'IEN D
. . S NODE=$G(^ECH(IEN,0)),PND=$G(^ECH(IEN,"P")),PX=$P(NODE,U,9)
. . Q:NODE="" S (PRV,CAT,ORS,ASC,PDXD)="",PDX=$P(PND,U,2)
. . I PX["EC" D
. . . S PRO=$G(^EC(725,$P(PX,";"),0)),PX=$P(PRO,U,2)_" "_$P(PRO,U)
. . E S PRO=$$CPT^ICPTCOD($P(PX,";"),PDT) S PX=$P(PRO,U,2)_" "_$P(PRO,U,3)
. . S:$P(NODE,U,8) CAT=$$GET1^DIQ(726,$P(NODE,U,8),.01,"I")
. . K PROV S ECU=$$GETPPRV^ECPRVMUT(IEN,.PROV),PRV=$S(ECU:"UNKNOWN",1:$P(PROV,"^",2)),ECU=$S('ECU:+PROV,1:"")
. . S:$P(NODE,U,12) ORS=$$GET1^DIQ(723,$P(NODE,U,12),.01,"I")
. . S:$P(NODE,U,19) ASC=$$GET1^DIQ(44,$P(NODE,U,19),.01,"I")
. . I PDX D
. . . ; ICD10 Changes
. . . S ECCS=$$SINFO^ICDEX("DIAG",PDT) ; Supported by ICR 5747
. . . S PDXD=$$ICDDX^ICDEX(PDX,PDT,+ECCS,"I") ; Supported by ICR 5747
. . . S ECCS=$P(ECCS,U,2),ECCS=" ("_$P(ECCS,"-",1)_$P(ECCS,"-",2)_")"
. . . S PDXD=$P(PDXD,U,2)_" "_$P(PDXD,U,4)_ECCS
. . S DATA=$P(NODE,U)_U_$$FMTE^XLFDT($P(NODE,U,3),"2F")_U_CAT_U_PX
. . S DATA=DATA_U_$P(NODE,U,10)_U_PRV_U_ORS_U_ASC_U_PDXD_U_ECU
. . S CNT=CNT+1,^TMP($J,"ECPATPX",CNT)=DATA
S RESULTS=$NA(^TMP($J,"ECPATPX"))
Q
PARSE(ECV,ECARY) ;Parse Variable
N I
F I=1:1:$L(ECARY,U) S @$P(ECV,U,I)=$P(ECARY,U,I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUERPC 12420 printed Apr 09, 2024@21:02:11 Page 2
ECUERPC ;ALB/JAM - Event Capture Data Entry Broker Utilities ;1/25/18 12:38
+1 ;;2.0;EVENT CAPTURE;**25,32,33,46,47,59,72,95,114,126,129,131,139**;8 May 96;Build 7
+2 ;
+3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
+4 ; Reference to $$ICDDX^ICDEX supported by ICR5747
+5 ;
USRUNT(RESULTS,ECARY) ;
+1 ;This broker call returns an array of DSS units for a user & location
+2 ; RPC: EC GETUSRDSSUNIT
+3 ;INPUTS ECARY - Contains the following delimited elements
+4 ; 1. ECL - Location IEN (if define gives User's DSS
+5 ; units for a location)
+6 ; 2. ECDUZ - New Person IEN (if define gives list of
+7 ; DSS Units available to user)
+8 ; 3. ECSUMUSR - Indicates which report is requesting this
+9 ; list. (optional)
+10 ; 4. ECDUST - Indicates DSS unit status requested (A)ctive
+11 ; (I)nactive or (B)oth. (optional)
+12 ;
+13 ;OUTPUTS RESULTS - Array of DSS Units. Data pieces as follows:-
+14 ; PIECE - Description
+15 ; 1 IEN of file 724
+16 ; 2 Name of DSS Unit
+17 ; 3 Send to PCE Flag
+18 ; 4 Data Entry Date/Time Default
+19 ;139
NEW ECL,ECDUZ,CNT,STR,DPT,IEN,ECSUMUSR,ECDUST
+20 DO SETENV^ECUMRPC
+21 SET ECL=$PIECE(ECARY,U)
SET ECDUZ=$PIECE(ECARY,U,2)
IF ECL=""
IF ECDUZ=""
QUIT
+22 ;139
SET ECSUMUSR=$PIECE(ECARY,U,3)
SET ECDUST=$PIECE(ECARY,U,4)
if ECDUST=""
SET ECDUST="B"
+23 KILL ^TMP($JOB,"ECUSRUNT")
SET (DPT,CNT)=0
+24 IF ECL'=""
IF ECDUZ=""
SET ECDUZ=$GET(DUZ,U)
IF ECDUZ=""
QUIT
+25 ;139 Add special branch for the ECSUM report
IF $GET(ECSUMUSR)="ECSUM"
DO ECSUM
SET RESULTS=$NAME(^TMP($JOB,"ECUSRUNT"))
QUIT
+26 IF $DATA(^XUSEC("ECALLU",ECDUZ))
SET DPT=""
Begin DoDot:1
+27 IF ECL=""
SET ^TMP($JOB,"ECUSRUNT",CNT+1)="ALL^ALL"
QUIT
+28 IF ECL="ALL"
SET ECL=""
+29 FOR
SET DPT=$ORDER(^ECD("B",DPT))
if DPT=""
QUIT
SET IEN=0
Begin DoDot:2
+30 FOR
SET IEN=$ORDER(^ECD("B",DPT,IEN))
if 'IEN
QUIT
DO UNTCHK
End DoDot:2
End DoDot:1
+31 IF '$TEST
Begin DoDot:1
+32 IF ECL="ALL"
SET ECL=""
+33 FOR
SET DPT=$ORDER(^VA(200,ECDUZ,"EC",DPT))
if 'DPT
QUIT
SET IEN=DPT
DO UNTCHK
End DoDot:1
+34 SET RESULTS=$NAME(^TMP($JOB,"ECUSRUNT"))
+35 QUIT
UNTCHK ;Check if DSS unit exist as event code screen and if active
+1 NEW DSSF,DFD
+2 ;I '$D(^ECJ("AP",ECL,IEN))!($P($G(^ECD(IEN,0)),U,6)) Q
+3 IF ECL'=""
IF '$DATA(^ECJ("AP",ECL,IEN))
QUIT
+4 IF ($PIECE($GET(^ECD(IEN,0)),U,6))!('$PIECE($GET(^ECD(IEN,0)),U,8))
QUIT
+5 ;Check if event code screens associated with DSS unit are active
+6 IF ECL'=""
IF '$$ECSCHK(ECL,IEN)
QUIT
+7 SET DSSF=$PIECE(^ECD(IEN,0),"^",14)
if DSSF=""
SET DSSF="N"
+8 ; added by VMP
SET DFD=$SELECT($PIECE(^ECD(IEN,0),"^",12)="N":"N",1:"X")
+9 SET CNT=CNT+1
SET STR=IEN_"^"_$PIECE(^ECD(IEN,0),"^")_U_DSSF_"^"_DFD
+10 SET ^TMP($JOB,"ECUSRUNT",CNT)=STR
+11 QUIT
ECSCHK(ECL,ECIEN) ;Check if any event code screens associated with DSS unit are active; EC*129
+1 NEW ECAT,ECPRX,ECS,ECNODE,ECFLG
+2 SET ECAT=""
SET ECFLG=0
+3 FOR
SET ECAT=$ORDER(^ECJ("AP",ECL,ECIEN,ECAT))
if ECAT=""
QUIT
Begin DoDot:1
+4 SET ECPRX=""
FOR
SET ECPRX=$ORDER(^ECJ("AP",ECL,ECIEN,ECAT,ECPRX))
if ECPRX=""
QUIT
Begin DoDot:2
+5 SET ECS=0
FOR
SET ECS=$ORDER(^ECJ("AP",ECL,ECIEN,ECAT,ECPRX,ECS))
if 'ECS
QUIT
Begin DoDot:3
+6 SET ECNODE=$GET(^ECJ(ECS,0))
IF $PIECE(ECNODE,"^",2)=""
SET ECFLG=1
End DoDot:3
if ECFLG
QUIT
End DoDot:2
if ECFLG
QUIT
End DoDot:1
if ECFLG
QUIT
+7 QUIT ECFLG
+8 ;
ECSUM ;139 Section added to allow for sorting DSS units by status
+1 NEW DSSIEN,DSSNAME,NODE,STAT,DSSF,DFO,STR
+2 SET DSSNAME=""
FOR
SET DSSNAME=$ORDER(^ECD("B",DSSNAME))
if DSSNAME=""
QUIT
SET DSSIEN=0
FOR
SET DSSIEN=$ORDER(^ECD("B",DSSNAME,DSSIEN))
if '+DSSIEN
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^ECD(DSSIEN,0))
if NODE=""
QUIT
+4 ;DSS Unit not for use in Event Capture
IF '$PIECE(NODE,U,8)
QUIT
+5 ;DSS Unit status
SET STAT=$SELECT($PIECE(NODE,U,6):"I",1:"A")
+6 ;If not getting both active and inactive units, quit if unit status isn't what we're looking for
IF ECDUST'="B"
IF STAT'=ECDUST
QUIT
+7 ;For all locations, no need to check for event code screens. For single location, DSS unit must have at least one event code screen
IF ECL'="ALL"
IF '$DATA(^ECJ("AP",ECL,DSSIEN))
QUIT
+8 ;Send to PCE setting
SET DSSF=$PIECE(NODE,U,14)
if DSSF=""
SET DSSF="N"
+9 ;Unit's default date/time setting
SET DFD=$SELECT($PIECE(NODE,U,12)="N":"N",1:"X")
+10 SET CNT=CNT+1
SET STR=DSSIEN_U_$PIECE(NODE,U)_U_DSSF_U_DFD
+11 SET ^TMP($JOB,"ECUSRUNT",CNT)=STR
End DoDot:1
+12 QUIT
+13 ;
CAT(RESULTS,ECARY) ;
+1 ;This broker entry point returns an array of categories for an Event
+2 ;Code screen based on location and DSS unit.
+3 ; RPC: EC GETECSCATS
+4 ;INPUTS ECARY - Contains the following values separated by "^"
+5 ; ECL - Location IEN
+6 ; ECD - DSS Unit IEN
+7 ; ECCSTA-Active or inactive category
+8 ; A-ctive (default), I-nactive, B-oth
+9 ;
+10 ;OUTPUTS RESULTS - Array of categories. Data pieces as follows:-
+11 ; PIECE - Description
+12 ; 1 - Category IEN
+13 ; 2 - Category description
+14 ;
+15 NEW ECL,ECD,ECC,CNT,DATA,ECCSTA
+16 DO SETENV^ECUMRPC
+17 SET ECL=$PIECE(ECARY,U)
SET ECD=$PIECE(ECARY,U,2)
IF (ECL="")!(ECD="")
QUIT
+18 SET ECCSTA=$PIECE(ECARY,U,3)
+19 KILL ^TMP($JOB,"ECSCATS")
+20 DO CATS^ECHECK1
+21 MERGE ^TMP($JOB,"ECSCATS")=ECC
+22 SET RESULTS=$NAME(^TMP($JOB,"ECSCATS"))
+23 QUIT
PROC(RESULTS,ECARY) ;
+1 ;This broker entry point returns an array of procedures for an Event
+2 ;Code screen (file #720.3) based on location, DSS unit, and Category
+3 ; RPC: EC GETECSPROCS
+4 ;INPUTS ECARY - Contains the following values separated by "^"
+5 ; ECL - Location IEN
+6 ; ECD - DSS Unit IEN
+7 ; ECC - Category IEN
+8 ; ECDT - Procedure Date
+9 ;
+10 ;OUTPUTS RESULTS - Array of procedures. Data pieces as follows:-
+11 ; PIECE - Description
+12 ; 1 - EC National Number SPACE Procedure Name SPACE
+13 ; - [Synonym]
+14 ; 2 - Procedure Code
+15 ; 3 - CPT Code
+16 ; 4 - Default volume (1 if no default volume)
+17 ; 5 - Event code screen IEN
+18 ;
+19 ;126
NEW ECL,ECD,ECC,CNT,DATA,STR,ECCPT,PX,NAME,NUM
+20 DO SETENV^ECUMRPC
+21 SET ECL=$PIECE(ECARY,U)
SET ECD=$PIECE(ECARY,U,2)
SET ECC=$PIECE(ECARY,U,3)
+22 IF (ECL="")!(ECD="")
QUIT
+23 ;131
if $PIECE($GET(^ECD(ECD,0)),U,11)=0
SET ECC=""
if ECC=""
SET ECC=0
+24 SET ECDT=$PIECE(ECARY,U,4)
+25 KILL ^TMP($JOB,"ECPRO")
+26 DO PROS^ECHECK1
+27 ;126
SET CNT=1
SET NAME=""
FOR
SET NAME=$ORDER(^TMP("ECPRO",$JOB,"N2",NAME))
if NAME=""
QUIT
SET NUM=$ORDER(^TMP("ECPRO",$JOB,"N2",NAME,0))
Begin DoDot:1
+28 ;126
SET DATA=^TMP("ECPRO",$JOB,NUM)
SET PX=$PIECE(DATA,U)
+29 SET ECCPT=$SELECT(PX["EC":$PIECE($GET(^EC(725,+PX,0)),"^",5),1:+PX)
+30 SET STR=$PIECE(DATA,U,5)_" "_$PIECE(DATA,U,4)_" ["_$PIECE(DATA,U,3)_"]"_U_PX
+31 SET STR=STR_U_ECCPT_U_$SELECT($PIECE(DATA,U,6):+$PIECE(DATA,U,6),1:1)_U_$PIECE(DATA,U,2)
+32 ;126
SET ^TMP($JOB,"ECPRO",CNT)=STR
SET CNT=CNT+1
End DoDot:1
+33 SET RESULTS=$NAME(^TMP($JOB,"ECPRO"))
+34 KILL ^TMP("ECPRO",$JOB)
+35 QUIT
ECPXMOD(RESULTS,ECARY) ;
+1 ;Broker call returns modifier entries for a CPT Procedure
+2 ; RPC: EC GETPXMODIFIER
+3 ;INPUTS ECARY - Contains the following values separated by "^"
+4 ; ECCPT - CPT code ien (file #81)
+5 ; ECDT - Procedure date and time (fileman format)
+6 ;
+7 ;OUTPUTS RESULTS - Array of procedure modifiers
+8 ; 2-character modifier^modifer name^modifier ien #81.3
+9 ;
+10 NEW CNT,SUB,ECCPT,ECDT,DATA,ECMOD
+11 DO SETENV^ECUMRPC
+12 SET ECCPT=$PIECE(ECARY,U)
SET ECDT=$PIECE(ECARY,U,2)
IF ECDT=""
DO NOW^%DTC
SET ECDT=%
+13 IF ECCPT=""
QUIT
+14 KILL ^TMP($JOB,"ECPXMODS")
SET (SUB,CNT)=0
+15 SET DATA=$$CODM^ICPTCOD(ECCPT,"ECMOD","",ECDT)
IF +DATA<0
QUIT
+16 FOR
SET SUB=$ORDER(ECMOD(SUB))
if SUB=""
QUIT
IF $PIECE(ECMOD(SUB),U,2)'=""
Begin DoDot:1
+17 IF +$$MODP^ICPTMOD(ECCPT,$PIECE(ECMOD(SUB),U,2),"I",ECDT)>0
Begin DoDot:2
+18 SET CNT=CNT+1
SET ^TMP($JOB,"ECPXMODS",CNT)=SUB_U_ECMOD(SUB)
End DoDot:2
End DoDot:1
+19 SET RESULTS=$NAME(^TMP($JOB,"ECPXMODS"))
+20 QUIT
PRVDER(RESULTS,ECARY) ;
+1 ;remove this rpc before release;JAM 6/4/01
+2 ;This broker entry point returns an array of valid providers
+3 ; RPC: EC GETPROVIDER
+4 ;INPUTS ECARY - Contains the following subscripted elements
+5 ; ECDT - Procedure date
+6 ;
+7 ;OUTPUTS RESULTS - Array of providers. Data pieces as follows:-
+8 ; PIECE - Description
+9 ; IEN of file 200^Provider Name^occupation^specialty^
+10 ; subspecialty
+11 ;
+12 NEW IEN,CNT,ECUTN,KEY,USR
+13 DO SETENV^ECUMRPC
+14 SET ECDT=$PIECE($GET(ECARY),U)
SET ECDT=$SELECT(ECDT="":DT,1:ECDT)
+15 KILL ^TMP($JOB,"ECPRVDRS")
SET CNT=0
+16 FOR KEY="PROVIDER"
SET IEN=0
Begin DoDot:1
+17 FOR
SET IEN=$ORDER(^XUSEC(KEY,IEN))
if 'IEN
QUIT
SET USR=$GET(^VA(200,IEN,0))
if USR'=""
Begin DoDot:2
+18 SET ECUTN=$$GET^XUA4A72(IEN,ECDT)
IF +ECUTN'>0
QUIT
+19 SET CNT=CNT+1
SET ^TMP($JOB,"ECPRVDRS",CNT)=IEN_U_$PIECE(USR,U)_U_$PIECE(ECUTN,2,4)
End DoDot:2
End DoDot:1
+20 SET RESULTS=$NAME(^TMP($JOB,"ECPRVDRS"))
+21 QUIT
+22 ;
ELIG(RESULTS,ECARY) ;
+1 ;
+2 ;Broker call returns a list of patient eligibilities
+3 ; RPC: EC GETPATELIG
+4 ;INPUTS ECARY - Contains the following subscripted elements
+5 ; DFN - Patient ien (file #2)
+6 ;
+7 ;OUTPUTS RESULTS - Array of eligibilities
+8 ; primary/secondary elig flag^elig ien^elig description
+9 ;
+10 NEW CNT,SUB,DFN,VAEL
+11 DO SETENV^ECUMRPC
+12 SET DFN=$PIECE(ECARY,U)
IF DFN=""
QUIT
+13 KILL ^TMP($JOB,"ECPATELIG")
+14 DO ELIG^VADPT
IF $GET(VAEL(1))=""
QUIT
+15 SET ^TMP($JOB,"ECPATELIG",1)="1^"_VAEL(1)
SET SUB=0
SET CNT=1
+16 FOR
SET SUB=$ORDER(VAEL(1,SUB))
if SUB=""
QUIT
Begin DoDot:1
+17 SET CNT=CNT+1
SET ^TMP($JOB,"ECPATELIG",CNT)="0^"_VAEL(1,SUB)
End DoDot:1
+18 SET RESULTS=$NAME(^TMP($JOB,"ECPATELIG"))
+19 QUIT
PRDEFS(RESULTS,ECARY) ;
+1 ;This broker entry point returns the defaults for procedure data entry
+2 ; RPC: EC GETPRODEFS
+3 ;INPUTS ECARY - Contains the following values separated by "^"
+4 ; ECL - Location IEN
+5 ; ECD - DSS Unit IEN
+6 ; ECC - Category IEN
+7 ;
+8 ;OUTPUTS RESULTS - Data pieces as follows:-
+9 ; PIECE - Description
+10 ; 1 - Associated Clinic IEN
+11 ; 2 - Associated Clinic
+12 ; 3 - Medical Specialty IEN
+13 ; 4 - Medical Specialty
+14 ;
+15 NEW ECL,ECD,ECC,ECP,IEN,ASC,ASCNM,MEDSP,MEDSPNM,ECCH
+16 DO SETENV^ECUMRPC
+17 SET ECL=$PIECE(ECARY,U)
SET ECD=$PIECE(ECARY,U,2)
SET ECC=$PIECE(ECARY,U,3)
SET ECP=$PIECE(ECARY,U,4)
+18 if ECC=""
SET ECC=0
IF (ECL="")!(ECD="")
QUIT
+19 SET (ASCNM,MEDSPNM)=""
SET ECCH=ECL_"-"_ECD_"-"_ECC_"-"_ECP
+20 IF '$DATA(^ECJ("B",ECCH))
QUIT
+21 SET IEN=$ORDER(^ECJ("B",ECCH,0))
IF IEN=""
QUIT
+22 SET ASC=$PIECE($GET(^ECJ(IEN,"PRO")),U,4)
IF ASC
Begin DoDot:1
+23 SET ASCNM=$$GET1^DIQ(44,ASC,.01,"I")
End DoDot:1
+24 SET MEDSP=$PIECE($GET(^ECD(ECD,0)),U,3)
IF MEDSP
Begin DoDot:1
+25 SET MEDSPNM=$$GET1^DIQ(723,MEDSP,.01,"I")
End DoDot:1
+26 SET RESULTS=ASC_U_ASCNM_U_MEDSP_U_MEDSPNM
+27 QUIT
PATPROC(RESULTS,ECARY) ;
+1 ;
+2 ;Broker call returns the entries from EVENT CAPTURE PATIENT FILE #721
+3 ;
+4 ;RPC: EC GETPATPROCS
+5 ;
+6 ;INPUTS ECARY - Contains the following values separated by "^"
+7 ; ECLOC - Location ien
+8 ; ECPAT - Patient DFN ien
+9 ; ECUNT - DSS unit ien
+10 ; ECSD - Start Date
+11 ; ECED - End Date
+12 ;
+13 ;OUTPUTS RESULTS - Array of Event Capture Patient entries contain
+14 ; 721 IEN^Procedure date/time^Category^Procedure^Volume^
+15 ; Provider^ordering section^associated clinic^
+16 ; (ICD Coding system) primary dx code primary dx code description
+17 ; ^Provider IEN
+18 ;
+19 NEW IEN,CNT,ECCS,ECV,ECLOC,ECUNT,ECPAT,PX,NODE,DATA,PDT,PDX,PND,PDXD,CAT,ECI
+20 NEW ORS,PRV,PRO,PROV,ECU
+21 ;set environment variables for RPC broker
DO SETENV^ECUMRPC
+22 SET ECV="ECLOC^ECPAT^ECUNT^ECSD^ECED"
+23 DO PARSE(ECV,ECARY)
IF (ECLOC="")!(ECPAT="")!(ECUNT="")
QUIT
+24 KILL ^TMP($JOB,"ECPATPX")
+25 SET ECSD=$GET(ECSD,DT)
SET ECED=$GET(ECED,DT)
+26 SET %DT="X"
FOR ECI="ECSD","ECED"
SET X=@ECI
DO ^%DT
SET @ECI=Y
+27 KILL X,Y
+28 SET ECSD=$SELECT(ECSD=-1:DT,1:ECSD)-.0001
SET ECED=$SELECT(ECED=-1:DT,1:ECED)+.9999
+29 if ECED'>ECSD
QUIT
SET PDT=ECSD
SET CNT=0
+30 FOR
SET PDT=$ORDER(^ECH("ADT",ECLOC,ECPAT,ECUNT,PDT))
if 'PDT!(PDT>ECED)
QUIT
Begin DoDot:1
+31 SET IEN=0
FOR
SET IEN=$ORDER(^ECH("ADT",ECLOC,ECPAT,ECUNT,PDT,IEN))
if 'IEN
QUIT
Begin DoDot:2
+32 SET NODE=$GET(^ECH(IEN,0))
SET PND=$GET(^ECH(IEN,"P"))
SET PX=$PIECE(NODE,U,9)
+33 if NODE=""
QUIT
SET (PRV,CAT,ORS,ASC,PDXD)=""
SET PDX=$PIECE(PND,U,2)
+34 IF PX["EC"
Begin DoDot:3
+35 SET PRO=$GET(^EC(725,$PIECE(PX,";"),0))
SET PX=$PIECE(PRO,U,2)_" "_$PIECE(PRO,U)
End DoDot:3
+36 IF '$TEST
SET PRO=$$CPT^ICPTCOD($PIECE(PX,";"),PDT)
SET PX=$PIECE(PRO,U,2)_" "_$PIECE(PRO,U,3)
+37 if $PIECE(NODE,U,8)
SET CAT=$$GET1^DIQ(726,$PIECE(NODE,U,8),.01,"I")
+38 KILL PROV
SET ECU=$$GETPPRV^ECPRVMUT(IEN,.PROV)
SET PRV=$SELECT(ECU:"UNKNOWN",1:$PIECE(PROV,"^",2))
SET ECU=$SELECT('ECU:+PROV,1:"")
+39 if $PIECE(NODE,U,12)
SET ORS=$$GET1^DIQ(723,$PIECE(NODE,U,12),.01,"I")
+40 if $PIECE(NODE,U,19)
SET ASC=$$GET1^DIQ(44,$PIECE(NODE,U,19),.01,"I")
+41 IF PDX
Begin DoDot:3
+42 ; ICD10 Changes
+43 ; Supported by ICR 5747
SET ECCS=$$SINFO^ICDEX("DIAG",PDT)
+44 ; Supported by ICR 5747
SET PDXD=$$ICDDX^ICDEX(PDX,PDT,+ECCS,"I")
+45 SET ECCS=$PIECE(ECCS,U,2)
SET ECCS=" ("_$PIECE(ECCS,"-",1)_$PIECE(ECCS,"-",2)_")"
+46 SET PDXD=$PIECE(PDXD,U,2)_" "_$PIECE(PDXD,U,4)_ECCS
End DoDot:3
+47 SET DATA=$PIECE(NODE,U)_U_$$FMTE^XLFDT($PIECE(NODE,U,3),"2F")_U_CAT_U_PX
+48 SET DATA=DATA_U_$PIECE(NODE,U,10)_U_PRV_U_ORS_U_ASC_U_PDXD_U_ECU
+49 SET CNT=CNT+1
SET ^TMP($JOB,"ECPATPX",CNT)=DATA
End DoDot:2
End DoDot:1
+50 SET RESULTS=$NAME(^TMP($JOB,"ECPATPX"))
+51 QUIT
PARSE(ECV,ECARY) ;Parse Variable
+1 NEW I
+2 FOR I=1:1:$LENGTH(ECARY,U)
SET @$PIECE(ECV,U,I)=$PIECE(ECARY,U,I)
+3 QUIT
