ECUMRPC1 ;ALB/JAM-Event Capture Management Broker Utilities ;3/9/18  08:59
 ;;2.0;EVENT CAPTURE;**25,30,33,72,94,95,105,100,107,110,112,126,130,131,134,139**;8 May 96;Build 7
 ;
DSSUNT(RESULTS,ECARY) ;
 ;
 ;This broker entry point returns DSS units from file 724
 ;        RPC: EC GETDSSUNIT
 ;INPUTS         ECARY -Contains the following subscripted elements
 ;               P1 =   optional field to return DSS Units
 ;                      STAT; 'A'ctive (default), 'I'nactive, 'B'oth
 ;               P2 =   optional field to filter based on the DSS Name
 ;               P3 =   optional field to return 1 DSS unit by IEN, if used
 ;                      no other filters evaluated
 ;               P4 =   optional field to filter based on the DSS Unit Number (DSS Dept)
 ;               
 ;               if data is passed into the other fields then all criteria
 ;               must be met for data on a unit to be returned
 ;
 ;OUTPUTS        RESULTS - Array of DSS units. Data pieces as follows:-
 ;               PIECE - Description
 ;                 1     IEN of DSS Unit 
 ;                 2     Name of DSS Unit
 ;                 3     IEN of DSS Unit
 ;                 4     Inactive flag
 ;                 5     Send to PCE   
 ;                 6     Unit Number
 ;                 7     Service
 ;                 8     Medical Specialty
 ;                 9     Cost Center
 ;                 10    Associated Stop code (if not sending to PCE)
 ;                 11    Category flag
 ;                 12    Default date entry
 ;                 13    Credit Stop Code (only available when SEND TO PCE is set to "no records"
 ;                 14    CHAR4 code (only available when SEND TO PCE is set to "no records"
 ;                 15    Allow duplicate records in spreadsheet upload
 ;
 
UNT,STAT,CNT,CAT,NODE,ECS,STR,SRV,MED,CST,UNO,INACT,ASC,PCE,ACT,NODE
 
DFD,DIEN,DNM,DUNIT,GET1,CSC,CHAR4,ADSS ;126,139
 
SETENV^ECUMRPC
 
^TMP($J,"ECDSSUNT")
 
DNM=$P($G(ECARY),U,2),DIEN=$P($G(ECARY),U,3),DUNIT=$P($G(ECARY),U,4)
 
S:DNM'="" DNM=$$UP^XLFSTR(DNM)
 
S:DUNIT'="" DUNIT=$$UP^XLFSTR(DUNIT)
 
STAT=$P($G(ECARY),U),(CNT,UNT,GET1)=0 S:STAT="" STAT="A"
 ; if IEN passed in - use that, then quit, GET1 used as control to stop
 
I $G(DIENUNT=DIEN-.001,GET1=1
 
F  S UNT=$O(^ECD(UNT)) Q:'UNT!((UNT>DIEN&(GET1)))  NODE=$G(^ECD(UNT,0)) NODE'="" D
 
ECS=$P(NODE,U,8),ACT=$P(NODE,U,6),ACT=$S(ACT:1,1:0)
 . 
Q:('ECS)
 . 
'$G(DIEN),$S(STAT="A"&(ACT):1,STAT="I"&('ACT):1,1:0) Q
 
; execute new filters
 
DNM'="",$$UP^XLFSTR($P(NODE,U))'[DNM Q
 
DUNIT'="",$$UP^XLFSTR($P(NODE,U,5))'[DUNIT Q
 
DIEN'="",$$UP^XLFSTR(UNT)'[DIEN Q
 
CNT=CNT+1,CAT=$P(NODE,U,11),CAT=$S(CAT:"Y",1:"N"),UNO=$P(NODE,U,5)
 . 
SRV=$$GET1^DIQ(49,$P(NODE,U,2),.01,"I")
 . 
MED=$$GET1^DIQ(723,$P(NODE,U,3),.01,"I")
 . 
CST=$$GET1^DIQ(420.1,$P(NODE,U,4),.01,"I")
 . 
INACT=$P(NODE,U,6),INACT=$S(INACT:"I",1:"A"),ASC=$P(NODE,U,10),CSC=$P(NODE,U,13),CHAR4=$P(NODE,U,15) ;126
 
S:ASC ASC=$$GET1^DIQ(40.7,ASC,.01,"I")
 . 
S:CSC CSC=$$GET1^DIQ(40.7,CSC,.01) ;126
 
S:CHAR4 CHAR4=$$GET1^DIQ(728.441,CHAR4,.01) ;126
 
DFD=$S($P(NODE,U,12)="N":"N",1:"X"),PCE=$P(NODE,U,14)
 . 
PCE=$S(PCE'="":PCE,1:"N";139
 
ADSS=$S($P(NODE,U,16)'="":$P(NODE,U,16),1:"N";139 Does DSS Unit allow duplicate record upload
 
STR=UNT_U_$P(NODE,U)_U_UNT_U_INACT_U_PCE_U_UNO_U_SRV_U_MED_U_CST
 
STR=STR_U_ASC_U_CAT_U_DFD_U_CSC_U_CHAR4_U_ADSS,^TMP($J,"ECDSSUNT",CNT)=STR ;126,139
 
RESULTS=$NA(^TMP($J,"ECDSSUNT"))
 
Q
CAT(RESULTS,ECARY) ;
 ;
 ;This broker entry point returns a list of categories from file 726
 ;        RPC: EC GETCAT
 ;INPUTS         ECARY - Contains the following subscripted elements
 ;                STAT - Active or inactive category (optional)
 ;                A-ctive (default), I-nactive, B-oth
 ;
 ;OUTPUTS        RESULTS - Array of category. Data pieces as follows:-
 ;               PIECE - Description
 ;                 1     IEN of Category
 ;                 2     Name of Category
 ;                 3     Creation Date
 ;                 4     Inactive Date
 ;
 
STAT,CNT,CAT,NODE,ECDT,INDT,CRDT
 
SETENV^ECUMRPC
 
^TMP($J,"ECCAT")
 
STAT=$P($G(ECARY),U),(CNT,CAT)=0 S:STAT="" STAT="A"
 
F  S CAT=$O(^EC(726,CAT)) Q:'CAT  NODE=$G(^EC(726,CAT,0)) NODE'="" D
 
ECDT=$P(NODE,U,3)
 . 
STAT="A",ECDT'="",ECDT'>DT Q
 
STAT="I",ECDT="" Q
 
CRDT=$$FMTE^XLFDT($P(NODE,U,2),"2F")
 . 
INDT=$$FMTE^XLFDT($P(NODE,U,3),"2F")
 . 
;S CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_CRDT_U_INDT
 
CNT=CNT+1,^TMP($J,"ECCAT",CNT)=CAT_U_$P(NODE,U)_U_$P(CRDT,"@",1)_U_$P(INDT,"@",1)
 
RESULTS=$NA(^TMP($J,"ECCAT"))
 
Q
 
;
CATCHK(RESULTS,ECARY) ;
 ;
 ;Broker call checks whether category is used in an Event Code Screen.
 ;        RPC: EC DSSCATCHECK
 ;INPUTS   ECARY  - Contains the following subscripted elements
 ;          ECDA  - DSS Unit ien (file #724)
 ;
 ;OUTPUTS  RESULTS - Category used in Event Code Screen, 1-Yes or 0-No
 ;
 
ECDA,ECFLG,ECX
 
SETENV^ECUMRPC
 
ECDA=$P(ECARY,UECDA="" Q
 S 
(ECFLG,ECX)=0
 
F  S ECX=$O(^ECJ("AP",ECX)) Q:'ECX!(ECFLG)  D
 
I $D(^ECJ("AP",ECX,ECDA)) ECFLG=1
 
RESULTS=ECFLG
 
Q
PXCHK(RESULTS,ECARY) ;
 ;
 ;Checks whether procedure description or national number exist
 ;INPUTS   ECARY  - Contains the following subscripted elements
 ;          ECP - Procedure description
 ;          ECN - EC National Number
 ;
 ;OUTPUTS  RESULTS - Px used^National # used, 1-Yes or 0-No ex. 1^0
 ;
 
ECX,ECP,ECN
 
Q:$G(ECARY)
 
SETENV^ECUMRPC
 
ECP=$P(ECARY,U),ECN=$P(ECARY,U,2),RESULTS="0^0"
 
ECP'="",$D(^EC(725,"B",ECP)) S $P(RESULTS,U)=1
 
ECN'="" ECX="E","D","DL" D  I $P(RESULTS,U,2) Q
 
I $D(^EC(725,ECX,ECN)) S $P(RESULTS,U,2)=1
 
Q
SRCLST(RESULTS,ECARY) ;
 ;
 ;This broker entry returns an array of codes from a file based on a 
 ;search string.
 ;        RPC: EC GETLIST
 ;
 ;INPUTS    ECARY   - Contains the following subscripted elements
 ;          ECFIL   - File to search
 ;          ECSTR   - Search string
 ;          ECDIR   - Search order
 ;          ECNUM   - (Optional) # records to return [default=44]
 ;          ECADT   - (Optional) date to determine clinic inactivity
 ;          ECLOC   - (Optional) location to filter associated clinics
 ;          ECTYPE  - (Optional) primary or secondary stop codes desired
 ;          ECOOS   - (Optional) Set to "OOS" to only see "OOS" related stop codes
 ;OUTPUTS   RESULTS - Array of values based on the search criteria.
 ;
 
ECNT,DIC,ECSTR,ECFIL,ECORD,ECER,ECDI,ECNUM,ECDIR,ECADT,ECLOC,ECTYPE,ECOOS ;112,126,139
 
SETENV^ECUMRPC
 
ECNT=0,ECFIL=$P(ECARY,U),ECSTR=$P(ECARY,U,2),ECDIR=$P(ECARY,U,3)
 
ECORD=$S(ECDIR=-1:"B",1:"I")
 
^TMP($J,"ECFIND"),^TMP("ECSRCH",$J)
 
ECFIL="" Q
 S 
ECNUM=$S(+$P(ECARY,U,4)>0:$P(ECARY,U,4),1:44)
 
ECADT=$S(+$P(ECARY,U,5):$P(ECARY,U,5),1:DT;112
 
ECLOC=$P(ECARY,U,6) ;126 IEN of location if filtering.  Null if no filtering
 
ECTYPE=$P(ECARY,U,7) ;126 Null if primary, not null for secondary
 
ECOOS=$P(ECARY,U,8) ;139 Set to "OOS" if list is restricted to "OOS" type stop codes
 
ECFIL=420.1 CSTCTR            ;Cost Center search
 
ECFIL=49 SERVC                ;Service search
 
ECFIL=723 MEDSPC              ;Medical specialty
 
ECFIL=40.7 STPCDE EXIT      ;Associated stop code
 
ECFIL=724 DUNT EXIT         ;DSS Unit
 
ECFIL=726 ECAT                ;Category
 
ECFIL=4 LOC                   ;Location
 
ECFIL=44 ASCLN EXIT         ;Associated clinic
 
ECFIL=757.01 LEX^ECUMRPC2 EXIT  ;Lex ICD code
 
ECFIL=200 PROV^ECUMRPC2(ECNUM)      ;Providers
 
ECFIL=728.441 CHAR4                 ;126 National Clinic code (CHAR4)
 
ECFIL=722 LIST^ECPRVDR              ;134 EC Providers
 
I $D(ECER^TMP($J,"ECFIND",1)="0^Error occurred during search" EXIT
 
SORT
EXIT 
^TMP("ECSRCH",$J)
 
RESULTS=$NA(^TMP($J,"ECFIND"))
 
Q
ASCLN ;Search for active associated clinics (file #44)
 
CLN,CNT,NOD,ECDT,INACT,REACT,ERR,ECNOD ;126
 
CNT=0,ECDT=ECADT ;112
 
(ECDIR'=1)&(ECDIR'=-1) ECDIR=1
 
;the next 2 lines of code compensate for the M collating sequence & how the
 ;clinic code is passed in from a CPRS RPC, in a unique situation. If the
 ;code is numeric, ending in 0 and there is a similar code ending with a
 ;letter, the correct clinic is not returned. EX: 2 clinics, 3010 and "3010A"
 ;exist, the code is written to return 3010, yet 3010A is incorrectly returned. 
 ;This code puts the 0 back on and subtracts 1 to the clinic code
 
I $E(ECSTR,$L(ECSTR)-1)="/",$E(ECSTR,1,($L(ECSTR)-2))?.D
 
.ECSTR=$E(ECSTR,1,($L(ECSTR)-2))_0,ECSTR=ECSTR-1
 
F  Q:CNT'<ECNUM  ECSTR=$O(^SC("B",ECSTR),ECDIRQ:ECSTR=""  CLN="" D  ;134 Stop if counter is greater than or equal to ECNUM - allows for duplicate clinic names
 
.F  S CLN=$O(^SC("B",ECSTR,CLN),ECDIRQ:CLN=""  NOD=$G(^SC(CLN,0)) D
 
..Q:NOD=""  Q:$P(NOD,U,3)'="C"  ;Q:+$G(^SC(CLN,"OOS"))
 
..I $G(ECLOCECLOC'=$$GET1^DIQ(44,CLN,"3.5:.07","I"Q  ;126,130 Clinic must be assoicated with the selected location, if one was selected
 
..ERR=0 I $D(^SC(CLN,"I")) D  I ERR Q
 
...INACT=$P(^SC(CLN,"I"),U),REACT=$P(^SC(CLN,"I"),U,2)
 ...
INACT D  I ERR Q
 
....REACT="" S:ECDT'<INACT ERR=1 Q
 
....ECDT'<INACT,ECDT<REACT ERR=1 Q
 
...;I REACT,ECDT<REACT S ERR=1  removed in EC*110 - BGP
 
..ECNOD=$G(^ECX(728.44,CLN,0)) ;126 Get clinic and stop code zero node for selected clinic
 
..CNT=CNT+1,^TMP($J,"ECFIND",CNT)=CLN_U_$P(NOD,U)_U_$P(ECNOD,U,2)_U_$P(ECNOD,U,3)_U_$P($G(^ECX(728.441,+$P(ECNOD,U,8),0)),U;126 Add stop code, credit stop, and char4 code
 
Q
CSTCTR ;Search for cost centers (File #420.1)
 
ECNULL,INDX,STR,NSTR,I
 
S $P(ECNULL," ",7)=" ",INDX="B"
 
I $E(ECSTR)?.N,$L(ECSTR)<7 ECSTR=ECSTR_$E(ECNULL,1,7-$L(ECSTR))
 
I $L($P(ECSTR," "))=6,$P(ECSTR," ",2)?.D   ;truncate for x-ref
 
ECSTR=$P(ECSTR," ")_" "_$E($P(ECSTR," ",2,999),1,22)
 
I $E(ECSTR)?.INDX="C",(STR,NSTR)="" D  S ECSTR=NSTR
 
.I=1:1 STR=$P(ECSTR," ",IQ:STR=""  D
 
..STR=$E(STR)_$TR($E(STR,2,9999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
 ..
NSTR=NSTR_STR
 
LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"",INDX,"I '$P(^(0),U,2)","","^TMP(""ECSRCH"",$J)","ECER")
 
Q
SERVC ;Search for services (File #49)
 
LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
 
Q
MEDSPC ;Search for medical specialty (File #723)
 
LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","","","^TMP(""ECSRCH"",$J)","ECER")
 
Q
STPCDE ;Search for associated stop code (File #40.7)
 
ECNT,INDX,ECNUL,STR,IEN,SCRN ;139
 
S $P(ECNUL,"  ",30)=" ",INDX="B",ECNT=0,ECSTR=$P(ECSTR,"~")
 
+ECSTR,ECSTR["/" ECSTR=$TR(ECSTR,"/",0) S:ECSTR>0 ECSTR=ECSTR-1 ;131 If number sent, remove / and replace with 0
 
+ECSTR,+ECSTR?.INDX="C",IEN=0 D  Q
 
.ECSTR=$O(^DIC(40.7,INDX,+ECSTR)) ECSTR="" Q
 
.F  S IEN=$O(^DIC(40.7,INDX,ECSTR,IEN)) Q:'IEN  D  I ECNT>(ECNUM-1) Q
 
..;07/27/09 llh added checks on piece 2 and 6
 
..STR=$G(^DIC(40.7,IEN,0)) ($P(STR,U,3)'=""&($P(STR,U,3)'>DT))!($P(STR,U,6)=$S($G(ECTYPE)="":"S",1:"P"))!($P(STR,U,6)="")!($L($P(STR,U,2))'=3) Q  ;126 allow for searches for primary or secondary
 
..I $G(ECOOS)="OOS" '$$EX^SDCOU2(IEN,$$NOW^XLFDT) Q  ;139 If setting up OOS DSS unit, only show OOS related stop codes
 
..STR=$E($P(STR,U),1,30)_"  ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)_U_IEN
 
..ECNT=ECNT+1,^TMP($J,"ECFIND",ECNT)=STR
 
;added validation checks here as well
 
SCRN="I $P(^(0),U,3)=""""!($P(^(0),U,3)'<DT)&($L($P(^(0),U,2))=3)&(($P(^(0),U,6)=$S($G(ECTYPE)="""":""P"",1:""S""))!($P(^(0),U,6)=""E""))"_$S(ECOOS="OOS":" I $$EX^SDCOU2(Y,$$NOW^XLFDT)",1:"";139
 
LISTDIC(ECFIL,"",".01;1",ECORD,ECNUM,ECSTR,"",INDX,SCRN,"","^TMP(""ECSRCH"",$J)","ECER";126,139
 
ECNT=0
 
F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
 
.STR=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_$G(^(1))
 .
STR=$E($P(STR,U),1,30)_"  ["_$J($P(STR,U,2),3,0)_"]"_U_$P(STR,U,2)
 .
^TMP($J,"ECFIND",ECNT)=STR_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)
 
Q
DUNT ;Search for DSS unit (File #724)
 
ECNT,SNDPCE
 
LISTDIC(ECFIL,"",".01;10;13",ECORD,ECNUM,ECSTR,"","","I '$P(^(0),""^"",6),$P(^(0),U,8)","","^TMP(""ECSRCH"",$J)","ECER")
 
ECNT=0
 
F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
 
.SNDPCE=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,13))
 .
SNDPCE=$S(SNDPCE="A":1,1:0) ;139 Send all records enables clinic selection, else no clinic
 
.^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)_U_$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,10))_U_SNDPCE
 
Q
ECAT ;Search for Category (File #726)
 
LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $P(^(0),""^"",3)=""""!($P(^(0),U,3)>DT)","","^TMP(""ECSRCH"",$J)","ECER")
 
Q
LOC ;Search for Location (File #4)
 
LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $G(^(""EC""))","","^TMP(""ECSRCH"",$J)","ECER")
 
Q
LISTDIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER) ;
 ;Produces a list of records in a file base on search string
 
DIC
 
LIST^DIC(ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECIND,ECTG,ECER)
 
ECFL,ECIEN,ECFLD,ECFLG,ECNUM,ECFRM,ECPRT,ECINDX,ECSCN,ECID
 
Q
SORT ;Extracts data to be returned to broker
 
ECNT,STR
 
ECNT=0
 
F  S ECNT=$O(^TMP("ECSRCH",$J,"DILIST","ID",ECNT)) Q:'ECNT  D
 
.^TMP($J,"ECFIND",ECNT)=$G(^TMP("ECSRCH",$J,"DILIST","ID",ECNT,.01))_U_^TMP("ECSRCH",$J,"DILIST",2,ECNT)
 
Q
 
;
CHAR4 ;126, returns list of CHAR4 codes from the NATIONAL CLINIC file (#728.441)
 
LISTDIC(ECFIL,"",.01,ECORD,ECNUM,ECSTR,"","","I $P($G(^(2)),""^"")=""""!($P($G(^(2)),""^"")>DT)","","^TMP(""ECSRCH"",$J)","ECER")
 
Q