Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECUERPC2

ECUERPC2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to 2^VADPT in ICR #10061
  1.  ; Reference to $$GET^XUA4A72 in ICR #1625
  1.  ; Reference to ^DIC(4) in ICR #10090
  1.  ; Reference to $$DT^XLFDT) in ICR #10103
  1.  ; Reference to LIST^GMPLUTL2,DETAIL^GMPLUTL2 in ICR #2741
  1.  ; Reference to $$GET1^DIQ in ICR #2056
  1.  ; Reference to ^TMP supported by SACC 2.3.2.5.1
  1.  ; Reference to $$SINFO^ICDEX,CODEN^ICDEX in ICR #5747
  1.  ;
  1. ECDOD(RESULTS,ECARY) ;RPC Broker entry point to get a patient's date of death
  1.  ;        RPC: EC DIEDON
  1.  ;INPUTS   ECARY - Contains the following elements as input
  1.  ;          ECDFN - Patient DFN
  1.  ;
  1.  ;OUTPUTS  RESULTS - Fileman Internal Date of Patient date of Death^
  1.  ;                   Message with Patient External Date of Death
  1.  ;
  1.  N ECDFN,DFN,VADM
  1.  D SETENV^ECUMRPC
  1.  S ECDFN=$P(ECARY,U),RESULTS="^"
  1.  I ECDFN="" S RESULTS="0^Patient DFN not defined" Q
  1.  ;NOIS MWV-0603-21781: line below changed by VMP
  1.  S DFN=ECDFN D 2^VADPT I +VADM(6) S RESULTS=$P(VADM(6),U)_"^"_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"]"
  1.  Q
  1. VISINFO(RESULTS,ECARY) ;
  1.  ;
  1.  ;Broker call returns the EC values based on a Visit Number
  1.  ;        RPC: EC GETVISITINFO
  1.  ;INPUTS   ECARY - Contains the following subscripted elements
  1.  ;          ECVSN - Visit Number, IEN in file (#9000010)
  1.  ;
  1.  ;OUTPUTS  RESULTS - Contains the following data:-
  1.  ;        Location IEN^Location Name^DSS Unit IEN^DSS Unit Name^Send to
  1.  ;        PCE^Procedure Date/Time Fileman^Procedure Date/Time Readable^
  1.  ;        Patient DFN
  1.  ;        or, if error encountered
  1.  ;        0^Error Message
  1.  ;
  1.  N ECLOC,ECUNT,NODE,Y,ECPXDT,DA,ECVSN,ECDFN,DSSF,LOC,UNT
  1.  D SETENV^ECUMRPC
  1.  S ECVSN=$P(ECARY,U) I ECVSN="" S RESULTS=0_"^Visit undefined" Q
  1.  K ^TMP($J,"ECVISINFO")
  1.  S DA=$O(^ECH("C",ECVSN,0)) I 'DA D  Q
  1.  . S RESULTS=0_"^Visit not on File"
  1.  S NODE=$G(^ECH(DA,0)) I NODE="" D  Q
  1.  . S RESULTS=0_"No corresponding EC procedures found for Visit"
  1.  S ECLOC=$P(NODE,U,4),ECUNT=$P(NODE,U,7),ECPXDT=$P(NODE,U,3)
  1.  S LOC=$P($G(^DIC(4,ECLOC,0)),U),UNT=$G(^ECD(ECUNT,0)),DSSF=$P(UNT,U,14)
  1.  S UNT=$P(UNT,U) S:DSSF="" DSSF="N"
  1.  S ECDFN=$P(NODE,U,2),Y=ECPXDT X ^DD("DD")
  1.  S RESULTS=ECLOC_U_LOC_U_ECUNT_U_UNT_U_DSSF_U_ECPXDT_U_Y_U_ECDFN
  1.  Q
  1. PATPRV(ECIEN) ;
  1.  ;Returns to broker a patient providers (primary & secondary) entries
  1.  ;from EVENT CAPTURE PATIENT FILE #721
  1.  ;INPUTS   ECIEN - Event Capture Patient ien
  1.  ;
  1.  ;OUTPUTS  RESULTS - Array of Event Capture Patient file contains
  1.  ;          ^ECH IEN^provider ien^provider description^Primary/Secondary
  1.  ;           code^Primary/Secondary description
  1.  ;
  1.  N ECPRV,ECPROV
  1.  I '$D(^ECH(ECIEN,"PRV")) Q
  1.  K ^TMP($J,"ECPRV")
  1.  S ECPRV=$$GETPRV^ECPRVMUT(ECIEN,.ECPROV) I 'ECPRV D
  1.  .M ^TMP($J,"ECPRV")=ECPROV
  1.  S RESULTS=$NA(^TMP($J,"ECPRV"))
  1.  Q
  1.  ;
  1. ECDEFPRV(RESULTS,ECARY) ;134 Section added
  1.  ;Returns default provider based on user and DSS unit
  1.  ;INPUT    ECARY contains IEN of DSS unit^Procedure date/time
  1.  ;
  1.  ;OUTPUT   RESULTS - IEN^Provider Name if default found
  1.  ;                   -1^ if no default identified
  1.  N DSSIEN,PROCDT,DSSUPCE,PROVIEN
  1.  S RESULTS=-1_"^"
  1.  S DSSIEN=+ECARY Q:'DSSIEN  ;Quit if no DSS unit identified
  1.  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
  1.  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
  1.  S RESULTS=$$CHK(DUZ) Q:+RESULTS>0  ;Stop if current user is a provider
  1.  D ECDEF^ECUERPC1(.PROVIEN,200) Q:'+PROVIEN  ;Stop if no record in 200 for this user was identified
  1.  S RESULTS=$$CHK(+PROVIEN)
  1.  Q
  1.  ;
  1. CHK(NUM) ;134 Section added to find default provider
  1.  N ECINFO
  1.  S ECINFO=$$GET^XUA4A72(NUM,PROCDT)
  1.  I +ECINFO>0 Q NUM_U_$$GET1^DIQ(200,NUM_",",.01)_U_$P(ECINFO,U,2,4)
  1.  I +ECINFO<0,DSSUPCE="N",$D(^EC(722,"B",NUM)) Q NUM_U_$$GET1^DIQ(200,NUM_",",.01)
  1.  Q -1_"^"
  1.  ;
  1. GETPLST(RESULTS,ECARY) ;156 - Broker call entry point to get a patient's problem list
  1.  ;RPC: EC GETPRBLST
  1.  ;INPUTS   ECARY - Contains the following elements as input
  1.  ;          ECDFN - Patient DFN
  1.  ;          ECSTAT - Status of the problem: Active/Inactive or null
  1.  ;
  1.  ;OUTPUTS  RESULTS - Array of Patient's problems contains
  1.  ;          Problem Status^ICD Code^ICD Code Description^Onset Date^Last Modified Date^Provider^Service^Current coding flag
  1.  ;
  1.  N ECGMPL,I,ECIEN,ECSTAT,CNT,ICDDESC,PRBLST,GMPL,PRBIEN,CCODESYS,CODEIEN ;159 Added CCODESYS, CODEIEN
  1.  S CCODESYS=$P($$SINFO^ICDEX("DIAG"),U,3) ; 159 - Get the current coding system
  1.  S ECIEN=$P(ECARY,U),ECSTAT=$P(ECARY,U,2)
  1.  D LIST^GMPLUTL2(.PRBLST,ECIEN,ECSTAT) ;ICR #2741
  1.  I $G(PRBLST(0))<1 S RESULTS="0^No Problem List found for Patient" Q
  1.  S CNT=0
  1.  F  S CNT=$O(PRBLST(CNT)) Q:CNT=""  D
  1.  . S PRBIEN=$P(PRBLST(CNT),U)
  1.  . K GMPL
  1.  . D DETAIL^GMPLUTL2(PRBIEN,.GMPL) ;ICR #2741
  1.  . S CODEIEN=$$ICDDX^ICDEX(GMPL("DIAGNOSIS"),GMPL("DTINTEREST"),CCODESYS,"E") ;ICR # 5747 - 159 added DX IEN
  1.  . S ECGMPL(CNT)=$G(GMPL("STATUS"))_U_$G(GMPL("DIAGNOSIS"))_U_$G(GMPL("ICDD"))_U_$G(GMPL("ONSET"))_U_$G(GMPL("MODIFIED"))_U
  1.  . 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
  1.  S ECGMPL(0)=PRBLST(0)
  1.  M ^TMP($J,"ECPLIST")=ECGMPL
  1.  S RESULTS=$NA(^TMP($J,"ECPLIST"))
  1.  Q