BMXRPC10	; IHS/OIT/GIS - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ; 08 Jun 2010  8:47 AM
	;;4.1000;BMX;;Apr 17, 2011
	;; LOGIN RPCS TO RETURN PATIENTS, VISITS AND FACILITIES.  SUPPORTS MULTI-INDEX PATIENT LOOKUP (DOB, NAME, CHART#, ETC)
	;
GETFCRS(BMXFACS,BMXDUZ)	; EP - Gets all facilities for a user - returns RECORDSET
	;
	;S BMXFACS="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002MOST_RECENT_LOOKUP"_$C(30)
	N BMXI
	S BMXI=0,BMXFACS=$NA(^TMP("BMX FIND",$J)) K @BMXFACS
	S ^TMP("BMX FIND",$J,0)="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002MOST_RECENT_LOOKUP"_$C(30)
	I $G(BMXDUZ)="" G XFRCS
	N BMXFN,BMXN,BMXSUB,BMXRCNT,CREF,OREF,SITE,LAST,DFLT
	S BMXDUZ=$TR(BMXDUZ,$C(13),"")
	S BMXDUZ=$TR(BMXDUZ,$C(10),"")
	S BMXDUZ=$TR(BMXDUZ,$C(9),"")
	S BMXFN=0
	S CREF=$NA(^VA(200,BMXDUZ,2))
	I '$O(@CREF@(0)) D  G XFRCS ; GIS/OIT JAN 22, 2010 ; Ensure at least one site returned
	. S BMXFN=$P(^AUTTSITE(1,0),U,1)
	. S SITE=$P($G(^DIC(4,BMXFN,0)),U,1)
	. S DFLT=0
	. S BMXI=BMXI+1
	. S ^TMP("BMX FIND",$J,BMXI)=SITE_U_BMXFN_U_DFLT_$C(30)
	. Q
	S OREF="^VA(200,"_BMXDUZ_",2,"
	S LAST=$G(^DISV(BMXDUZ,OREF))
	I LAST="" D
	. S BMXFN=0
	. F  Q:LAST  S BMXFN=$O(VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN  D  I LAST Q
	.. I $P($G(^VA(200,BMXDUZ,2,BMXFN,0)),U,2) S LAST=BMXFN
	.. Q
	. Q
	I LAST="" S LAST=$O(^VA(200,BMXDUZ,2,0)) ; IF LAST UNDEFINED, DEFAULT TO 1 ENTRY FOR THAT USER IN THE DIVISION SUBFILE
	I LAST="" S LAST=$P($G(^XTV(8989.3,1,"XUS")),U,17) ; IF LAST UNDEFINED, GET VALUE FROM KERNEL SYSTEM PARAMETERS FILE
	S BMXFN=0,STG=""
	F  S BMXFN=$O(@CREF@(BMXFN)) Q:'BMXFN  D
	. S SITE=$P($G(^DIC(4,BMXFN,0)),U,1) I SITE="" Q
	. S DFLT=(LAST=BMXFN)
	. S BMXI=BMXI+1
	. S ^TMP("BMX FIND",$J,BMXI)=SITE_U_BMXFN_U_DFLT_$C(30)
	. Q
XFRCS	S BMXI=BMXI+1
	S ^TMP("BMX FIND",$J,BMXI)=$C(31)
	Q
	;
GETVIS(OUT,STG)	; EP - RETURN SPECIFIED # OF VALID VISITS FOR THE PATIENT
	S OUT="T00010VISIT_IEN^T00030PATIENT_IEN^T00021TIMESTAMP^T00030VISIT_TYPE^T00030LOCATION^T00010SERVICE CATEGORY^T00030CLINIC^T00030PRIMARY_PROVIDER^T00030PRIMARY_POV"_$C(30)
	I $L($G(STG))
	E  G VOUT
	N X,Y,Z,%,HDR,LINE,DFN,MAX,IDT,VIEN,CNT,STOP,TS,VIEN,TYPE,LOC,SCAT,CLIN,PPRV,PPOV,BDT,VDT,DATA
	S DFN=+STG I '$D(^DPT(DFN,0)) G VOUT
	S MAX=$P(STG,"|",2) I 'MAX S MAX=9
	I '$O(^AUPNVSIT("AA",+$G(DFN),0)) G VOUT
	S IDT=0,CNT=0,STOP=0,DATA=""
	S BDT=$$FMADD^XLFDT(DT,-2)
	F  Q:STOP  S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:'IDT  S VIEN=999999999999 F  Q:STOP  S VIEN=$O(^AUPNVSIT("AA",DFN,IDT,VIEN),-1) Q:'VIEN  D  Q
	. S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q  ; VISIT DATA MUST EXIST
	. S VDT=+X I 'VDT Q
	. I $P(X,U,11) Q  ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED'
	. I $P(X,U,5)'=DFN Q  ; INVALID PATIENT IEN
	. I $P(X,U,3)="" Q  ; VISIT MUST HAVE A TYPE
	. I '$P(X,U,6) Q  ; MUST HAVE A VALID ENCOUNTER LOCATION
	. I $P(X,U,7)="" Q  ; VISIT MUST HAVE A CATEGORY
	. I $P(X,U,8)="" Q  ; VISIT MUST HAVE A VALID CLINIC STOP
	. I VDT<BDT,'$D(^AUPNVPOV("AD",VIEN)) Q  ; MUST HAVE A POV ; PATCHED BY GIS 4/27/2009
	. I VDT<BDT,'$D(^AUPNVPRV("AD",VIEN)) Q  ; MUST HAVE A PROVIDER
	. D VIS(VIEN,DFN,.DATA)
	. S CNT=CNT+1
	. I CNT=MAX S STOP=1
	. Q
VOUT	S OUT=OUT_$G(DATA)_$C(31)
	Q
	;
VIS(VIEN,DFN,DATA)	; EP - APPEND VISIT DATA STRING
	I $G(VIEN),$G(DFN)
	E  Q
	N TYPE,LOC,SCAT,CLIN,PPRV,PPOV,VDT,FIEN,IENS,FLD,TYPE
	S FIEN=9000010,IENS=VIEN_","
	S TS=$$GET1^DIQ(FIEN,IENS,.01) I TS="" Q
	S TYPE=$$GET1^DIQ(FIEN,IENS,.03)
	S LOC=$$GET1^DIQ(FIEN,IENS,.06)
	S SCAT=$$GET1^DIQ(FIEN,IENS,.07)
	S CLIN=$$GET1^DIQ(FIEN,IENS,.08)
	S PPRV=$$PPRV(VIEN)
	S PPOV=$$PPOV(VIEN)
	S DATA=DATA_VIEN_U_DFN_U_TS_U_LOC_U_SCAT_U_CLIN_U_PPRV_U_PPOV_$C(30)
	Q
	; 
PPRV(VIEN)	; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PROVIDER NAME
	; CALLED BY THE BMX SCHEMA
	I '$D(^AUPNVPRV("AD",+$G(VIEN))) Q ""
	N NAME,PIEN,VPIEN,X,Y,Z,%
	S VPIEN=0,PIEN=""
	F  S VPIEN=$O(^AUPNVPRV("AD",VIEN,VPIEN)) Q:'VPIEN  D  I PIEN Q
	. S X=$G(^AUPNVPRV(VPIEN,0)) I X="" Q
	. S TYPE=$P(X,U,4)
	. I TYPE="P" S PIEN=+X
	. Q
	I 'PIEN S VPIEN=$O(^AUPNVPRV("AD",VIEN,0)) I VPIEN S PIEN=+$G(^AUPNVPRV(VPIEN,0))
	I 'PIEN Q ""
	S PIEN=$$PRV^VENPCCU(PIEN)
	S NAME=$P($G(^VA(200,PIEN,0)),U)
	Q NAME
	;
PPOV(VIEN)	; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PURPOSE OF VISIT ICD CODE (NARRATIVE)
	; CALLED BY BMX SCHEMA
	I '$D(^AUPNVPOV("AD",+$G(VIEN))) Q ""
	N TXT,IIEN,VPIEN,X,Y,Z,%,ICD,NIEN,DX
	S VPIEN=0,IIEN=""
	F  S VPIEN=$O(^AUPNVPOV("AD",VIEN,VPIEN)) Q:'VPIEN  D  I IIEN Q
	. S X=$G(^AUPNVPOV(VPIEN,0)) I X="" Q
	. S TYPE=$P(X,U,12)
	. I TYPE="P" S IIEN=+X
	. Q
	I 'IIEN S VPIEN=$O(^AUPNVPOV("AD",VIEN,0)) I VPIEN S IIEN=+$G(^AUPNVPOV(VPIEN,0))
	I IIEN,VPIEN
	E  Q ""
	I $L($T(ICDDX^ICDCODE)) S ICD=$P($$ICDDX^ICDCODE(IIEN),U,2) I 1
	E  S ICD=$P($G(^ICD9(IIEN,0)),U)
	I '$L(ICD) Q ""
	S NIEN=$P($G(^AUPNVPOV(VPIEN,0)),U,4) I 'NIEN Q ""
	S TXT=$P($G(^AUTNPOV(NIEN,0)),U) I TXT="" Q ""
	I $L(TXT)>20 S TXT=$E(TXT,1,17)_"..."
	S DX=ICD_" ("_TXT_")"
	Q DX
	; 
GETPAT(BMXRET,BMXSTR)	; EP - -- return patient in ADO table
	; S X="MERR^BMXGU",@^%ZOSF("TRAP") ; m error trap
	N BMXI,BMXERR,BMXUIEN,P,X,Y,Z,%,%DT
	S P="|"
	K ^BMXTMP($J)
	S BMXI=0
	S BMXERR=""
	S BMXRET="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030LASTUPDATE^T00030CLASSBEN^T00010AGE"_$C(30)
	S BMXPAT=$P(BMXSTR,P,1)
	S BMXMT=$P(BMXSTR,P,2)
	; S BMXNPAT=$P(BMXSTR,P,4)
	I BMXMT="ALL"!(BMXMT="") S BMXMT=9999999
	S BMXMT=(BMXMT-1)
	S BMXPIEN=""
	S X=BMXPAT D ^%DT
	S Y=Y\1
	I $E(Y,4,5)="00" G GETADO
	I $E(Y,6,7)="00" G GETADO
	I Y?7N D  G GETADO
	. S BMXPAT=Y
	. S BMXPATE=$$PATDOB(.BMXPIEN,BMXPAT)
	S X=$TR($P(BMXPAT," "),",","")
	I X?1.30U S BMXPATE=$$PATNAM(.BMXPIEN,BMXPAT,"") G GETADO
	I BMXPAT?9N D  G GETADO
	. S BMXPIEN=$$PATSSN(BMXPAT)
	I BMXPAT?1.6N D  G GETADO
	. S BMXPIEN=$$PATCHT(.BMXPIEN,BMXPAT)
GETADO	I $G(BMXPIEN),'$G(BMXPATS) D PATADO(.BMXPIEN)
	S BMXRET=BMXRET_$C(31)_$G(BMXERR)
	K BMXPAT,BMXPIEN,BMXCNT,BMXDA,BMXIEN,BMXPATE,BMXNM,BMXDB,BMXSX,BMXCT,BMXSSN
	K BMXPATS
	Q
	;
PATSSN(PAT)	;-- look up by ssn
	S BMXPIEN=$O(^DPT("SSN",PAT,0))
	S BMXPIEN(1)=BMXPIEN
	Q $G(BMXPIEN)
	;
PATCHT(BMXPIEN,HRN)	;-- lookup by chart
	N BMXCNT
	S BMXCNT=0,BMXPATE=0,BMXMCNT=0,BMXPIEN=""
	S BMXIEN=0 F  S BMXIEN=$O(^AUPNPAT("D",HRN,BMXIEN)) Q:'BMXIEN  D  I BMXPIEN Q
	. I '$D(^AUPNPAT("D",HRN,BMXIEN,DUZ(2))) Q
	. S %=$O(^AUPNPAT("D",HRN,BMXIEN)) I %,$D(^AUPNPAT("D",HRN,%,DUZ(2))) S BMXIEN=999999999 Q  ; MORE THAN ONE PAT WITH THIS CHART NUMBER!
	. S BMXPIEN=BMXIEN
	. S BMXCNT=BMXCNT+1
	. S:'$D(BMXPIEN(BMXCNT)) BMXPIEN(BMXCNT)=0
	. S BMXPIEN(BMXCNT)=BMXPIEN
	. Q
	Q BMXPIEN
	;
PATDOB(BMXPATE,PAT)	;-- lookup by DOB
	N BMXCNT
	S BMXCNT=0,BMXPATE=0
	S BMXIEN=0
	F  S BMXIEN=$O(^DPT("ADOB",PAT,BMXIEN)) Q:'BMXIEN  D
	. S:'$D(BMXPATE(BMXCNT)) BMXPATE(BMXCNT)=0
	. S BMXCNT=BMXCNT+1,BMXPATE=1
	. S BMXPATE(BMXCNT)=BMXIEN
	. Q
	S BMXPATE=BMXCNT
	Q $G(BMXPATE)
	;
PATNAM(BMXPATE,PAT,NPAT)	;lookup by name
	S BMXCNT=0,BMXPATE=0
	N BMXLEN
	S BMXLEN=$L(PAT)
	S BMXNAM=PAT
	S BMXNAM=$$BEGIN(PAT)
	I $G(NPAT)]"" S BMXNAM=NPAT
	F  S BMXNAM=$O(^DPT("B",BMXNAM)) Q:BMXNAM=""!($E(BMXNAM,1,BMXLEN)'=PAT)!(BMXCNT>BMXMT)  D
	. S BMXIEN=0 F  S BMXIEN=$O(^DPT("B",BMXNAM,BMXIEN)) Q:'BMXIEN  D
	.. Q:$O(^DPT("B",BMXNAM,BMXIEN,0))  ;cmi/maw 4/25/2005 don't get aliases
	.. S BMXCNT=BMXCNT+1
	.. S:'$D(BMXPATE(BMXCNT)) BMXPATE(BMXCNT)=0
	.. S BMXPATE(BMXCNT)=BMXIEN
	S BMXPATE=BMXCNT
	Q $G(BMXPATE)
	;
BEGIN(PT)	;-- get begin point
	N BMXPDA,BMXPIEN,BMXPCNT
	S BMXPCNT=0
	S BMXPDA=PT
	I $O(^DPT("B",BMXPDA,0)) D
	. S BMXPDA=$O(^DPT("B",BMXPDA),-1)
	F  S BMXPDA=$O(^DPT("B",BMXPDA)) Q
	I $G(BMXPDA)="" Q ""
	Q $O(^DPT("B",BMXPDA),-1)
	;
PATADO(PIEN)	;-- ado return
	I '$G(DUZ(2)) Q  ; DIVISION
	S BMXCNTR=0
	S BMXDA=0 F  S BMXDA=$O(PIEN(BMXDA)) Q:'BMXDA  D
	. S BMXCNTR=BMXCNTR+1
	. S BMXPI=$G(PIEN(BMXDA))
	. I '$D(^AUPNPAT(BMXPI,41,DUZ(2),0)) Q  ; PATIENT NOT REGISTERED IN THE CURRENT DIVISION
	. S BMXNM=$P($G(^DPT(BMXPI,0)),U)
	. S BMXDB=$$FMTE^XLFDT($P($G(^DPT(BMXPI,0)),U,3))
	. S BMXSX=$P($G(^DPT(BMXPI,0)),U,2)
	. S BMXCT=$$HRN^AUPNPAT(BMXPI,DUZ(2))
	. S BMXSSN=$P($G(^DPT(BMXPI,0)),U,9)
	. S BMXUPD=$P($G(^AUPNPAT(BMXPI,0)),U,3)
	. S BMXELG=$$GET1^DIQ(9000001,BMXPI,1111) ;cmi/maw 5/17/2007 added class/ben for status bar
	. S BMXAGE=$$AGE^AUPNPAT(BMXPI,DT)
	. S BMXI=BMXI+1
	. S BMXRET=BMXRET_BMXPI_U_BMXNM_U_BMXDB_U_BMXSX_U_BMXCT_U_BMXSSN_U_$G(BMXHD)_U_BMXUPD_U_BMXELG_U_BMXAGE_$C(30)
	Q
	;
BMXCCXT(RESULT,XOPTION)	;creates context for the passed in option
	N XWB1,%,IEN,SIEN,OK,OPTION
	S RESULT=0
	S OPTION=$$DECRYP^XUSRB1(XOPTION) ;S:OPTION="" OPTION="\"
	I $E(OPTION,1,3)="BMX" S RESULT=1 Q  ; NO RESTRICTIONS FOR BMX CONTEXT FOR THIS PORT
	K XQY0,XQY
	I OPTION="" S XQY=0,XQY0="" Q  ;delete context if "" passed in N PORT
	S PORT=+$P($P,"|",3) I 'PORT Q
	S IEN=$O(^BMXMON("B",PORT,0)) I 'IEN Q
	I '$O(^BMXMON(IEN,1,0)) G BC1  ; NO RESTRICTIONS ON CONTEXT FOR THIS PORT
	S OK=0,CIEN=0
	F  S CIEN=$O(^BMXMON(IEN,1,CIEN)) Q:'CIEN  D  I OK Q
	. S %=$P($G(^BMXMON(IEN,1,CIEN,0)),U) I '% Q
	. S %=$P($G(^DIC(19,%,0)),U) I %="" Q
	. I %=OPTION S OK=1
	. Q
	I 'OK S (XWBSEC,RESULT)="The context '"_OPTION_"' is not registered with port "_PORT_"." Q
BC1	S XWB1=$$OPTLK^XQCS(OPTION)
	I XWB1="" S (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server." Q  ;P10
	S RESULT=$$CHK^XQCS(DUZ,XWB1)
	;Access or programmer
BC2	I RESULT!$$KCHK^XUSRB("XUPROGMODE") S XQY0=OPTION,XQY=XWB1,RESULT=1 Q
	S XWBSEC=RESULT
	Q
	; 
CVC(OUT,IN)	; EP - RPC: BMX CVC ; CHECK VERIFY CODE (SEE CVC^XUSRB)
	S OUT(0)=99,OUT(1)="INVALID PARAMETERS"
	I $L(IN)
	E  Q
	N AV,EAC,EOVC,ENVC,USER,AC,OVC,NVC,EVC,NVC,X,Y,Z,%,RET,U
	S U="^",RET(0)="",RET(1)=""
	S AV=$$DECRYP^XUSRB1(IN) I AV="" Q
	S AC=$P(AV,";")
	S X=$$EN^XUSHSH(AC)
	S USER=$O(^VA(200,"A",X,0)) I 'USER Q
	S @$C(68,85,90)=USER
	S OVC=$P(AV,";",2) I OVC="" Q
	S NVC=$P(AV,";",3) I NVC="" Q
	S EOVC=$$ENCRYP^XUSRB1(OVC)
	S ENVC=$$ENCRYP^XUSRB1(NVC)
	D CVC^XUSRB(.RET,(ENVC_U_EOVC))
	M OUT=RET
	Q
	;
TEST	; TEST CVC
	N DUZ,IN
	S IN=$$ENCRYP^XUSRB1("GREG4330;IRA-1727;IRA-1727")
	D CVC^BMXRPC10(.OUT,IN) W !,$G(OUT(0))," - ",$G(OUT(1))
	Q
	;