ECUERPC2 ;ALB/JAM - Event Capture Data Entry Broker Util ;9/1/22 14:13
;;2.0;EVENT CAPTURE;**41,39,50,72,134,139,156,159**;8 May 96;Build 61
;
; Reference to 2^VADPT in ICR #10061
; Reference to $$GET^XUA4A72 in ICR #1625
; Reference to ^DIC(4) in ICR #10090
; Reference to $$DT^XLFDT) in ICR #10103
; Reference to LIST^GMPLUTL2,DETAIL^GMPLUTL2 in ICR #2741
; Reference to $$GET1^DIQ in ICR #2056
; Reference to ^TMP supported by SACC 2.3.2.5.1
; Reference to $$SINFO^ICDEX,CODEN^ICDEX in ICR #5747
;
ECDOD(RESULTS,ECARY) ;RPC Broker entry point to get a patient's date of death
; RPC: EC DIEDON
;INPUTS ECARY - Contains the following elements as input
; ECDFN - Patient DFN
;
;OUTPUTS RESULTS - Fileman Internal Date of Patient date of Death^
; Message with Patient External Date of Death
;
N ECDFN,DFN,VADM
D SETENV^ECUMRPC
S ECDFN=$P(ECARY,U),RESULTS="^"
I ECDFN="" S RESULTS="0^Patient DFN not defined" Q
;NOIS MWV-0603-21781: line below changed by VMP
S DFN=ECDFN D 2^VADPT I +VADM(6) S RESULTS=$P(VADM(6),U)_"^"_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"]"
Q
VISINFO(RESULTS,ECARY) ;
;
;Broker call returns the EC values based on a Visit Number
; RPC: EC GETVISITINFO
;INPUTS ECARY - Contains the following subscripted elements
; ECVSN - Visit Number, IEN in file (#9000010)
;
;OUTPUTS RESULTS - Contains the following data:-
; Location IEN^Location Name^DSS Unit IEN^DSS Unit Name^Send to
; PCE^Procedure Date/Time Fileman^Procedure Date/Time Readable^
; Patient DFN
; or, if error encountered
; 0^Error Message
;
N ECLOC,ECUNT,NODE,Y,ECPXDT,DA,ECVSN,ECDFN,DSSF,LOC,UNT
D SETENV^ECUMRPC
S ECVSN=$P(ECARY,U) I ECVSN="" S RESULTS=0_"^Visit undefined" Q
K ^TMP($J,"ECVISINFO")
S DA=$O(^ECH("C",ECVSN,0)) I 'DA D Q
. S RESULTS=0_"^Visit not on File"
S NODE=$G(^ECH(DA,0)) I NODE="" D Q
. S RESULTS=0_"No corresponding EC procedures found for Visit"
S ECLOC=$P(NODE,U,4),ECUNT=$P(NODE,U,7),ECPXDT=$P(NODE,U,3)
S LOC=$P($G(^DIC(4,ECLOC,0)),U),UNT=$G(^ECD(ECUNT,0)),DSSF=$P(UNT,U,14)
S UNT=$P(UNT,U) S:DSSF="" DSSF="N"
S ECDFN=$P(NODE,U,2),Y=ECPXDT X ^DD("DD")
S RESULTS=ECLOC_U_LOC_U_ECUNT_U_UNT_U_DSSF_U_ECPXDT_U_Y_U_ECDFN
Q
PATPRV(ECIEN) ;
;Returns to broker a patient providers (primary & secondary) entries
;from EVENT CAPTURE PATIENT FILE #721
;INPUTS ECIEN - Event Capture Patient ien
;
;OUTPUTS RESULTS - Array of Event Capture Patient file contains
; ^ECH IEN^provider ien^provider description^Primary/Secondary
; code^Primary/Secondary description
;
N ECPRV,ECPROV
I '$D(^ECH(ECIEN,"PRV")) Q
K ^TMP($J,"ECPRV")
S ECPRV=$$GETPRV^ECPRVMUT(ECIEN,.ECPROV) I 'ECPRV D
.M ^TMP($J,"ECPRV")=ECPROV
S RESULTS=$NA(^TMP($J,"ECPRV"))
Q
;
ECDEFPRV(RESULTS,ECARY) ;134 Section added
;Returns default provider based on user and DSS unit
;INPUT ECARY contains IEN of DSS unit^Procedure date/time
;
;OUTPUT RESULTS - IEN^Provider Name if default found
; -1^ if no default identified
N DSSIEN,PROCDT,DSSUPCE,PROVIEN
S RESULTS=-1_"^"
S DSSIEN=+ECARY Q:'DSSIEN ;Quit if no DSS unit identified
S PROCDT=$S($P(ECARY,U,2):$P(ECARY,U,2),1:$$DT^XLFDT) ;if no procedure date/time sent in use today's date
S DSSUPCE=$P($G(^ECD(DSSIEN,0)),U,14) S:DSSUPCE="" DSSUPCE="N" ;139 Get send to PCE setting, set to 'send no records' if null
S RESULTS=$$CHK(DUZ) Q:+RESULTS>0 ;Stop if current user is a provider
D ECDEF^ECUERPC1(.PROVIEN,200) Q:'+PROVIEN ;Stop if no record in 200 for this user was identified
S RESULTS=$$CHK(+PROVIEN)
Q
;
CHK(NUM) ;134 Section added to find default provider
N ECINFO
S ECINFO=$$GET^XUA4A72(NUM,PROCDT)
I +ECINFO>0 Q NUM_U_$$GET1^DIQ(200,NUM_",",.01)_U_$P(ECINFO,U,2,4)
I +ECINFO<0,DSSUPCE="N",$D(^EC(722,"B",NUM)) Q NUM_U_$$GET1^DIQ(200,NUM_",",.01)
Q -1_"^"
;
GETPLST(RESULTS,ECARY) ;156 - Broker call entry point to get a patient's problem list
;RPC: EC GETPRBLST
;INPUTS ECARY - Contains the following elements as input
; ECDFN - Patient DFN
; ECSTAT - Status of the problem: Active/Inactive or null
;
;OUTPUTS RESULTS - Array of Patient's problems contains
; Problem Status^ICD Code^ICD Code Description^Onset Date^Last Modified Date^Provider^Service^Current coding flag
;
N ECGMPL,I,ECIEN,ECSTAT,CNT,ICDDESC,PRBLST,GMPL,PRBIEN,CCODESYS,CODEIEN ;159 Added CCODESYS, CODEIEN
S CCODESYS=$P($$SINFO^ICDEX("DIAG"),U,3) ; 159 - Get the current coding system
S ECIEN=$P(ECARY,U),ECSTAT=$P(ECARY,U,2)
D LIST^GMPLUTL2(.PRBLST,ECIEN,ECSTAT) ;ICR #2741
I $G(PRBLST(0))<1 S RESULTS="0^No Problem List found for Patient" Q
S CNT=0
F S CNT=$O(PRBLST(CNT)) Q:CNT="" D
. S PRBIEN=$P(PRBLST(CNT),U)
. K GMPL
. D DETAIL^GMPLUTL2(PRBIEN,.GMPL) ;ICR #2741
. S CODEIEN=$$ICDDX^ICDEX(GMPL("DIAGNOSIS"),GMPL("DTINTEREST"),CCODESYS,"E") ;ICR # 5747 - 159 added DX IEN
. S ECGMPL(CNT)=$G(GMPL("STATUS"))_U_$G(GMPL("DIAGNOSIS"))_U_$G(GMPL("ICDD"))_U_$G(GMPL("ONSET"))_U_$G(GMPL("MODIFIED"))_U
. S ECGMPL(CNT)=ECGMPL(CNT)_$G(GMPL("PROVIDER"))_U_$G(GMPL("SERVICE"))_U_$S(GMPL("CSYS")=CCODESYS:1,1:0)_U_CODEIEN ;159 - Adding Current Code Falg and Code IEN
S ECGMPL(0)=PRBLST(0)
M ^TMP($J,"ECPLIST")=ECGMPL
S RESULTS=$NA(^TMP($J,"ECPLIST"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUERPC2 5431 printed Apr 09, 2024@21:00:52 Page 2
ECUERPC2 ;ALB/JAM - Event Capture Data Entry Broker Util ;9/1/22 14:13
+1 ;;2.0;EVENT CAPTURE;**41,39,50,72,134,139,156,159**;8 May 96;Build 61
+2 ;
+3 ; Reference to 2^VADPT in ICR #10061
+4 ; Reference to $$GET^XUA4A72 in ICR #1625
+5 ; Reference to ^DIC(4) in ICR #10090
+6 ; Reference to $$DT^XLFDT) in ICR #10103
+7 ; Reference to LIST^GMPLUTL2,DETAIL^GMPLUTL2 in ICR #2741
+8 ; Reference to $$GET1^DIQ in ICR #2056
+9 ; Reference to ^TMP supported by SACC 2.3.2.5.1
+10 ; Reference to $$SINFO^ICDEX,CODEN^ICDEX in ICR #5747
+11 ;
ECDOD(RESULTS,ECARY) ;RPC Broker entry point to get a patient's date of death
+1 ; RPC: EC DIEDON
+2 ;INPUTS ECARY - Contains the following elements as input
+3 ; ECDFN - Patient DFN
+4 ;
+5 ;OUTPUTS RESULTS - Fileman Internal Date of Patient date of Death^
+6 ; Message with Patient External Date of Death
+7 ;
+8 NEW ECDFN,DFN,VADM
+9 DO SETENV^ECUMRPC
+10 SET ECDFN=$PIECE(ECARY,U)
SET RESULTS="^"
+11 IF ECDFN=""
SET RESULTS="0^Patient DFN not defined"
QUIT
+12 ;NOIS MWV-0603-21781: line below changed by VMP
+13 SET DFN=ECDFN
DO 2^VADPT
IF +VADM(6)
SET RESULTS=$PIECE(VADM(6),U)_"^"_"[PATIENT DIED ON "_$PIECE(VADM(6),U,2)_"]"
+14 QUIT
VISINFO(RESULTS,ECARY) ;
+1 ;
+2 ;Broker call returns the EC values based on a Visit Number
+3 ; RPC: EC GETVISITINFO
+4 ;INPUTS ECARY - Contains the following subscripted elements
+5 ; ECVSN - Visit Number, IEN in file (#9000010)
+6 ;
+7 ;OUTPUTS RESULTS - Contains the following data:-
+8 ; Location IEN^Location Name^DSS Unit IEN^DSS Unit Name^Send to
+9 ; PCE^Procedure Date/Time Fileman^Procedure Date/Time Readable^
+10 ; Patient DFN
+11 ; or, if error encountered
+12 ; 0^Error Message
+13 ;
+14 NEW ECLOC,ECUNT,NODE,Y,ECPXDT,DA,ECVSN,ECDFN,DSSF,LOC,UNT
+15 DO SETENV^ECUMRPC
+16 SET ECVSN=$PIECE(ECARY,U)
IF ECVSN=""
SET RESULTS=0_"^Visit undefined"
QUIT
+17 KILL ^TMP($JOB,"ECVISINFO")
+18 SET DA=$ORDER(^ECH("C",ECVSN,0))
IF 'DA
Begin DoDot:1
+19 SET RESULTS=0_"^Visit not on File"
End DoDot:1
QUIT
+20 SET NODE=$GET(^ECH(DA,0))
IF NODE=""
Begin DoDot:1
+21 SET RESULTS=0_"No corresponding EC procedures found for Visit"
End DoDot:1
QUIT
+22 SET ECLOC=$PIECE(NODE,U,4)
SET ECUNT=$PIECE(NODE,U,7)
SET ECPXDT=$PIECE(NODE,U,3)
+23 SET LOC=$PIECE($GET(^DIC(4,ECLOC,0)),U)
SET UNT=$GET(^ECD(ECUNT,0))
SET DSSF=$PIECE(UNT,U,14)
+24 SET UNT=$PIECE(UNT,U)
if DSSF=""
SET DSSF="N"
+25 SET ECDFN=$PIECE(NODE,U,2)
SET Y=ECPXDT
XECUTE ^DD("DD")
+26 SET RESULTS=ECLOC_U_LOC_U_ECUNT_U_UNT_U_DSSF_U_ECPXDT_U_Y_U_ECDFN
+27 QUIT
PATPRV(ECIEN) ;
+1 ;Returns to broker a patient providers (primary & secondary) entries
+2 ;from EVENT CAPTURE PATIENT FILE #721
+3 ;INPUTS ECIEN - Event Capture Patient ien
+4 ;
+5 ;OUTPUTS RESULTS - Array of Event Capture Patient file contains
+6 ; ^ECH IEN^provider ien^provider description^Primary/Secondary
+7 ; code^Primary/Secondary description
+8 ;
+9 NEW ECPRV,ECPROV
+10 IF '$DATA(^ECH(ECIEN,"PRV"))
QUIT
+11 KILL ^TMP($JOB,"ECPRV")
+12 SET ECPRV=$$GETPRV^ECPRVMUT(ECIEN,.ECPROV)
IF 'ECPRV
Begin DoDot:1
+13 MERGE ^TMP($JOB,"ECPRV")=ECPROV
End DoDot:1
+14 SET RESULTS=$NAME(^TMP($JOB,"ECPRV"))
+15 QUIT
+16 ;
ECDEFPRV(RESULTS,ECARY) ;134 Section added
+1 ;Returns default provider based on user and DSS unit
+2 ;INPUT ECARY contains IEN of DSS unit^Procedure date/time
+3 ;
+4 ;OUTPUT RESULTS - IEN^Provider Name if default found
+5 ; -1^ if no default identified
+6 NEW DSSIEN,PROCDT,DSSUPCE,PROVIEN
+7 SET RESULTS=-1_"^"
+8 ;Quit if no DSS unit identified
SET DSSIEN=+ECARY
if 'DSSIEN
QUIT
+9 ;if no procedure date/time sent in use today's date
SET PROCDT=$SELECT($PIECE(ECARY,U,2):$PIECE(ECARY,U,2),1:$$DT^XLFDT)
+10 ;139 Get send to PCE setting, set to 'send no records' if null
SET DSSUPCE=$PIECE($GET(^ECD(DSSIEN,0)),U,14)
if DSSUPCE=""
SET DSSUPCE="N"
+11 ;Stop if current user is a provider
SET RESULTS=$$CHK(DUZ)
if +RESULTS>0
QUIT
+12 ;Stop if no record in 200 for this user was identified
DO ECDEF^ECUERPC1(.PROVIEN,200)
if '+PROVIEN
QUIT
+13 SET RESULTS=$$CHK(+PROVIEN)
+14 QUIT
+15 ;
CHK(NUM) ;134 Section added to find default provider
+1 NEW ECINFO
+2 SET ECINFO=$$GET^XUA4A72(NUM,PROCDT)
+3 IF +ECINFO>0
QUIT NUM_U_$$GET1^DIQ(200,NUM_",",.01)_U_$PIECE(ECINFO,U,2,4)
+4 IF +ECINFO<0
IF DSSUPCE="N"
IF $DATA(^EC(722,"B",NUM))
QUIT NUM_U_$$GET1^DIQ(200,NUM_",",.01)
+5 QUIT -1_"^"
+6 ;
GETPLST(RESULTS,ECARY) ;156 - Broker call entry point to get a patient's problem list
+1 ;RPC: EC GETPRBLST
+2 ;INPUTS ECARY - Contains the following elements as input
+3 ; ECDFN - Patient DFN
+4 ; ECSTAT - Status of the problem: Active/Inactive or null
+5 ;
+6 ;OUTPUTS RESULTS - Array of Patient's problems contains
+7 ; Problem Status^ICD Code^ICD Code Description^Onset Date^Last Modified Date^Provider^Service^Current coding flag
+8 ;
+9 ;159 Added CCODESYS, CODEIEN
NEW ECGMPL,I,ECIEN,ECSTAT,CNT,ICDDESC,PRBLST,GMPL,PRBIEN,CCODESYS,CODEIEN
+10 ; 159 - Get the current coding system
SET CCODESYS=$PIECE($$SINFO^ICDEX("DIAG"),U,3)
+11 SET ECIEN=$PIECE(ECARY,U)
SET ECSTAT=$PIECE(ECARY,U,2)
+12 ;ICR #2741
DO LIST^GMPLUTL2(.PRBLST,ECIEN,ECSTAT)
+13 IF $GET(PRBLST(0))<1
SET RESULTS="0^No Problem List found for Patient"
QUIT
+14 SET CNT=0
+15 FOR
SET CNT=$ORDER(PRBLST(CNT))
if CNT=""
QUIT
Begin DoDot:1
+16 SET PRBIEN=$PIECE(PRBLST(CNT),U)
+17 KILL GMPL
+18 ;ICR #2741
DO DETAIL^GMPLUTL2(PRBIEN,.GMPL)
+19 ;ICR # 5747 - 159 added DX IEN
SET CODEIEN=$$ICDDX^ICDEX(GMPL("DIAGNOSIS"),GMPL("DTINTEREST"),CCODESYS,"E")
+20 SET ECGMPL(CNT)=$GET(GMPL("STATUS"))_U_$GET(GMPL("DIAGNOSIS"))_U_$GET(GMPL("ICDD"))_U_$GET(GMPL("ONSET"))_U_$GET(GMPL("MODIFIED"))_U
+21 ;159 - Adding Current Code Falg and Code IEN
SET ECGMPL(CNT)=ECGMPL(CNT)_$GET(GMPL("PROVIDER"))_U_$GET(GMPL("SERVICE"))_U_$SELECT(GMPL("CSYS")=CCODESYS:1,1:0)_U_CODEIEN
End DoDot:1
+22 SET ECGMPL(0)=PRBLST(0)
+23 MERGE ^TMP($JOB,"ECPLIST")=ECGMPL
+24 SET RESULTS=$NAME(^TMP($JOB,"ECPLIST"))
+25 QUIT
