ECUERPC ;ALB/JAM;Event Capture Data Entry Broker Utilities ;Aug 16, 2000
 ;;2.0; EVENT CAPTURE ;**25,32,33,46,47,59,72**;8 May 96
 ;
USRUNT(RESULTS,ECARY) ;
 ;
 ;This broker call returns an array of DSS units for a user & location
 ;        RPC: EC GETUSRDSSUNIT
 ;INPUTS        ECARY  - Contains the following subscripted 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)
 ;
 ;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
 D SETENV^ECUMRPC
 S ECL=$P(ECARY,U),ECDUZ=$P(ECARY,U,2) I ECL="",ECDUZ="" Q
 ;S ECDUZ=$G(DUZ,U),ECL=$P(ECARY,U) I (ECDUZ="")!(ECL="") Q
 K ^TMP($J,"ECUSRUNT") S (DPT,CNT)=0
 I ECL'="",ECDUZ="" S ECDUZ=$G(DUZ,U) I ECDUZ="" Q
 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
 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
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
 D SETENV^ECUMRPC
 S ECL=$P(ECARY,U),ECD=$P(ECARY,U,2),ECC=$P(ECARY,U,3) S:ECC="" ECC=0
 I (ECL="")!(ECD="") Q
 S ECDT=$P(ECARY,U,4)
 K ^TMP($J,"ECPRO")
 D PROS^ECHECK1
 S CNT=0 F  S CNT=$O(^TMP("ECPRO",$J,CNT)) Q:'CNT  D
 .S DATA=^TMP("ECPRO",$J,CNT),PX=$P(DATA,U)
 .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
 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=""  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 and time^Category^Procedure^Volume^
 ;          Provider^ordering section^associated clinic^primary diagnoses
 ;          ^Provider IEN
 ;
 N IEN,CNT,ECV,ECLOC,ECUNT,ECPAT,PX,NODE,DATA,PDT,PDX,PND,PDXD,CAT,ECI
 N ORS,PRV,PRO,PROV,ECU
 D SETENV^ECUMRPC
 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")
 . . S:PDX PDXD=$$ICDDX^ICDCODE(PDX,PDT),PDXD=$P(PDXD,U,2)_" "_$P(PDXD,U,4)
 . . 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