| 1 | BMXRPC10 ; IHS/OIT/GIS - RPC CALL FOR EXTENDED BROKER FUNCTIONALITY ; 5/11/11 4:35pm
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 3 | ;; LOGIN RPCS TO RETURN PATIENTS, VISITS AND FACILITIES. SUPPORTS MULTI-INDEX PATIENT LOOKUP (DOB, NAME, CHART#, ETC)
|
|---|
| 4 | ;
|
|---|
| 5 | ; Changes in v 4.1000 to support GT.M
|
|---|
| 6 | ; - In BMXCCXT, there are several lines that rely on the
|
|---|
| 7 | ; settings in BMX MONITOR file. We don't use that on GT.M
|
|---|
| 8 | ; as xinetd handles all connection issues.
|
|---|
| 9 | ; Also, at this point, we don't have integrated windows authentication
|
|---|
| 10 | ; See below for the specific details.
|
|---|
| 11 | ;
|
|---|
| 12 | GETFCRS(BMXFACS,BMXDUZ) ; EP - Gets all facilities for a user - returns RECORDSET
|
|---|
| 13 | ;
|
|---|
| 14 | ;S BMXFACS="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002MOST_RECENT_LOOKUP"_$C(30)
|
|---|
| 15 | N BMXI
|
|---|
| 16 | S BMXI=0,BMXFACS=$NA(^TMP("BMX FIND",$J)) K @BMXFACS
|
|---|
| 17 | S ^TMP("BMX FIND",$J,0)="T00030FACILITY_NAME^T00030FACILITY_IEN^T00002MOST_RECENT_LOOKUP"_$C(30)
|
|---|
| 18 | I $G(BMXDUZ)="" G XFRCS
|
|---|
| 19 | N BMXFN,BMXN,BMXSUB,BMXRCNT,CREF,OREF,SITE,LAST,DFLT
|
|---|
| 20 | S BMXDUZ=$TR(BMXDUZ,$C(13),"")
|
|---|
| 21 | S BMXDUZ=$TR(BMXDUZ,$C(10),"")
|
|---|
| 22 | S BMXDUZ=$TR(BMXDUZ,$C(9),"")
|
|---|
| 23 | S BMXFN=0
|
|---|
| 24 | S CREF=$NA(^VA(200,BMXDUZ,2))
|
|---|
| 25 | I '$O(@CREF@(0)) D G XFRCS ; GIS/OIT JAN 22, 2010 ; Ensure at least one site returned
|
|---|
| 26 | . S BMXFN=$P(^AUTTSITE(1,0),U,1)
|
|---|
| 27 | . S SITE=$P($G(^DIC(4,BMXFN,0)),U,1)
|
|---|
| 28 | . S DFLT=0
|
|---|
| 29 | . S BMXI=BMXI+1
|
|---|
| 30 | . S ^TMP("BMX FIND",$J,BMXI)=SITE_U_BMXFN_U_DFLT_$C(30)
|
|---|
| 31 | . Q
|
|---|
| 32 | S OREF="^VA(200,"_BMXDUZ_",2,"
|
|---|
| 33 | S LAST=$G(^DISV(BMXDUZ,OREF))
|
|---|
| 34 | I LAST="" D
|
|---|
| 35 | . S BMXFN=0
|
|---|
| 36 | . F Q:LAST S BMXFN=$O(VA(200,BMXDUZ,2,BMXFN)) Q:'BMXFN D I LAST Q
|
|---|
| 37 | .. I $P($G(^VA(200,BMXDUZ,2,BMXFN,0)),U,2) S LAST=BMXFN
|
|---|
| 38 | .. Q
|
|---|
| 39 | . Q
|
|---|
| 40 | I LAST="" S LAST=$O(^VA(200,BMXDUZ,2,0)) ; IF LAST UNDEFINED, DEFAULT TO 1 ENTRY FOR THAT USER IN THE DIVISION SUBFILE
|
|---|
| 41 | I LAST="" S LAST=$P($G(^XTV(8989.3,1,"XUS")),U,17) ; IF LAST UNDEFINED, GET VALUE FROM KERNEL SYSTEM PARAMETERS FILE
|
|---|
| 42 | S BMXFN=0,STG=""
|
|---|
| 43 | F S BMXFN=$O(@CREF@(BMXFN)) Q:'BMXFN D
|
|---|
| 44 | . S SITE=$P($G(^DIC(4,BMXFN,0)),U,1) I SITE="" Q
|
|---|
| 45 | . S DFLT=(LAST=BMXFN)
|
|---|
| 46 | . S BMXI=BMXI+1
|
|---|
| 47 | . S ^TMP("BMX FIND",$J,BMXI)=SITE_U_BMXFN_U_DFLT_$C(30)
|
|---|
| 48 | . Q
|
|---|
| 49 | XFRCS S BMXI=BMXI+1
|
|---|
| 50 | S ^TMP("BMX FIND",$J,BMXI)=$C(31)
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | GETVIS(OUT,STG) ; EP - RETURN SPECIFIED # OF VALID VISITS FOR THE PATIENT
|
|---|
| 54 | S OUT="T00010VISIT_IEN^T00030PATIENT_IEN^T00021TIMESTAMP^T00030VISIT_TYPE^T00030LOCATION^T00010SERVICE CATEGORY^T00030CLINIC^T00030PRIMARY_PROVIDER^T00030PRIMARY_POV"_$C(30)
|
|---|
| 55 | I $L($G(STG))
|
|---|
| 56 | E G VOUT
|
|---|
| 57 | N X,Y,Z,%,HDR,LINE,DFN,MAX,IDT,VIEN,CNT,STOP,TS,VIEN,TYPE,LOC,SCAT,CLIN,PPRV,PPOV,BDT,VDT,DATA
|
|---|
| 58 | S DFN=+STG I '$D(^DPT(DFN,0)) G VOUT
|
|---|
| 59 | S MAX=$P(STG,"|",2) I 'MAX S MAX=9
|
|---|
| 60 | I '$O(^AUPNVSIT("AA",+$G(DFN),0)) G VOUT
|
|---|
| 61 | S IDT=0,CNT=0,STOP=0,DATA=""
|
|---|
| 62 | S BDT=$$FMADD^XLFDT(DT,-2)
|
|---|
| 63 | 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
|
|---|
| 64 | . S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q ; VISIT DATA MUST EXIST
|
|---|
| 65 | . S VDT=+X I 'VDT Q
|
|---|
| 66 | . I $P(X,U,11) Q ; MUST BE AN 'ACTIVE' VISIT - NOT 'DELETED'
|
|---|
| 67 | . I $P(X,U,5)'=DFN Q ; INVALID PATIENT IEN
|
|---|
| 68 | . I $P(X,U,3)="" Q ; VISIT MUST HAVE A TYPE
|
|---|
| 69 | . I '$P(X,U,6) Q ; MUST HAVE A VALID ENCOUNTER LOCATION
|
|---|
| 70 | . I $P(X,U,7)="" Q ; VISIT MUST HAVE A CATEGORY
|
|---|
| 71 | . I $P(X,U,8)="" Q ; VISIT MUST HAVE A VALID CLINIC STOP
|
|---|
| 72 | . I VDT<BDT,'$D(^AUPNVPOV("AD",VIEN)) Q ; MUST HAVE A POV ; PATCHED BY GIS 4/27/2009
|
|---|
| 73 | . I VDT<BDT,'$D(^AUPNVPRV("AD",VIEN)) Q ; MUST HAVE A PROVIDER
|
|---|
| 74 | . D VIS(VIEN,DFN,.DATA)
|
|---|
| 75 | . S CNT=CNT+1
|
|---|
| 76 | . I CNT=MAX S STOP=1
|
|---|
| 77 | . Q
|
|---|
| 78 | VOUT S OUT=OUT_$G(DATA)_$C(31)
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | VIS(VIEN,DFN,DATA) ; EP - APPEND VISIT DATA STRING
|
|---|
| 82 | I $G(VIEN),$G(DFN)
|
|---|
| 83 | E Q
|
|---|
| 84 | N TYPE,LOC,SCAT,CLIN,PPRV,PPOV,VDT,FIEN,IENS,FLD,TYPE
|
|---|
| 85 | S FIEN=9000010,IENS=VIEN_","
|
|---|
| 86 | S TS=$$GET1^DIQ(FIEN,IENS,.01) I TS="" Q
|
|---|
| 87 | S TYPE=$$GET1^DIQ(FIEN,IENS,.03)
|
|---|
| 88 | S LOC=$$GET1^DIQ(FIEN,IENS,.06)
|
|---|
| 89 | S SCAT=$$GET1^DIQ(FIEN,IENS,.07)
|
|---|
| 90 | S CLIN=$$GET1^DIQ(FIEN,IENS,.08)
|
|---|
| 91 | S PPRV=$$PPRV(VIEN)
|
|---|
| 92 | S PPOV=$$PPOV(VIEN)
|
|---|
| 93 | S DATA=DATA_VIEN_U_DFN_U_TS_U_LOC_U_SCAT_U_CLIN_U_PPRV_U_PPOV_$C(30)
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | PPRV(VIEN) ; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PROVIDER NAME
|
|---|
| 97 | ; CALLED BY THE BMX SCHEMA
|
|---|
| 98 | I '$D(^AUPNVPRV("AD",+$G(VIEN))) Q ""
|
|---|
| 99 | N NAME,PIEN,VPIEN,X,Y,Z,%
|
|---|
| 100 | S VPIEN=0,PIEN=""
|
|---|
| 101 | F S VPIEN=$O(^AUPNVPRV("AD",VIEN,VPIEN)) Q:'VPIEN D I PIEN Q
|
|---|
| 102 | . S X=$G(^AUPNVPRV(VPIEN,0)) I X="" Q
|
|---|
| 103 | . S TYPE=$P(X,U,4)
|
|---|
| 104 | . I TYPE="P" S PIEN=+X
|
|---|
| 105 | . Q
|
|---|
| 106 | I 'PIEN S VPIEN=$O(^AUPNVPRV("AD",VIEN,0)) I VPIEN S PIEN=+$G(^AUPNVPRV(VPIEN,0))
|
|---|
| 107 | I 'PIEN Q ""
|
|---|
| 108 | S PIEN=$$PRV^VENPCCU(PIEN)
|
|---|
| 109 | S NAME=$P($G(^VA(200,PIEN,0)),U)
|
|---|
| 110 | Q NAME
|
|---|
| 111 | ;
|
|---|
| 112 | PPOV(VIEN) ; EP - GIVEN A VISIT IEN, RETURN THE PRIMARY PURPOSE OF VISIT ICD CODE (NARRATIVE)
|
|---|
| 113 | ; CALLED BY BMX SCHEMA
|
|---|
| 114 | I '$D(^AUPNVPOV("AD",+$G(VIEN))) Q ""
|
|---|
| 115 | N TXT,IIEN,VPIEN,X,Y,Z,%,ICD,NIEN,DX
|
|---|
| 116 | S VPIEN=0,IIEN=""
|
|---|
| 117 | F S VPIEN=$O(^AUPNVPOV("AD",VIEN,VPIEN)) Q:'VPIEN D I IIEN Q
|
|---|
| 118 | . S X=$G(^AUPNVPOV(VPIEN,0)) I X="" Q
|
|---|
| 119 | . S TYPE=$P(X,U,12)
|
|---|
| 120 | . I TYPE="P" S IIEN=+X
|
|---|
| 121 | . Q
|
|---|
| 122 | I 'IIEN S VPIEN=$O(^AUPNVPOV("AD",VIEN,0)) I VPIEN S IIEN=+$G(^AUPNVPOV(VPIEN,0))
|
|---|
| 123 | I IIEN,VPIEN
|
|---|
| 124 | E Q ""
|
|---|
| 125 | I $L($T(ICDDX^ICDCODE)) S ICD=$P($$ICDDX^ICDCODE(IIEN),U,2) I 1
|
|---|
| 126 | E S ICD=$P($G(^ICD9(IIEN,0)),U)
|
|---|
| 127 | I '$L(ICD) Q ""
|
|---|
| 128 | S NIEN=$P($G(^AUPNVPOV(VPIEN,0)),U,4) I 'NIEN Q ""
|
|---|
| 129 | S TXT=$P($G(^AUTNPOV(NIEN,0)),U) I TXT="" Q ""
|
|---|
| 130 | I $L(TXT)>20 S TXT=$E(TXT,1,17)_"..."
|
|---|
| 131 | S DX=ICD_" ("_TXT_")"
|
|---|
| 132 | Q DX
|
|---|
| 133 | ;
|
|---|
| 134 | GETPAT(BMXRET,BMXSTR) ; EP - -- return patient in ADO table
|
|---|
| 135 | ; S X="MERR^BMXGU",@^%ZOSF("TRAP") ; m error trap
|
|---|
| 136 | N BMXI,BMXERR,BMXUIEN,P,X,Y,Z,%,%DT
|
|---|
| 137 | S P="|"
|
|---|
| 138 | K ^BMXTMP($J)
|
|---|
| 139 | S BMXI=0
|
|---|
| 140 | S BMXERR=""
|
|---|
| 141 | S BMXRET="T00010IEN^T00030PATIENTNAME^T00015DOB^T00001SEX^T00007CHART^T00009SSN^T00010REG^T00030LASTUPDATE^T00030CLASSBEN^T00010AGE"_$C(30)
|
|---|
| 142 | S BMXPAT=$P(BMXSTR,P,1)
|
|---|
| 143 | S BMXMT=$P(BMXSTR,P,2)
|
|---|
| 144 | ; S BMXNPAT=$P(BMXSTR,P,4)
|
|---|
| 145 | I BMXMT="ALL"!(BMXMT="") S BMXMT=9999999
|
|---|
| 146 | S BMXMT=(BMXMT-1)
|
|---|
| 147 | S BMXPIEN=""
|
|---|
| 148 | S X=BMXPAT D ^%DT
|
|---|
| 149 | S Y=Y\1
|
|---|
| 150 | I $E(Y,4,5)="00" G GETADO
|
|---|
| 151 | I $E(Y,6,7)="00" G GETADO
|
|---|
| 152 | I Y?7N D G GETADO
|
|---|
| 153 | . S BMXPAT=Y
|
|---|
| 154 | . S BMXPATE=$$PATDOB(.BMXPIEN,BMXPAT)
|
|---|
| 155 | S X=$TR($P(BMXPAT," "),",","")
|
|---|
| 156 | I X?1.30U S BMXPATE=$$PATNAM(.BMXPIEN,BMXPAT,"") G GETADO
|
|---|
| 157 | I BMXPAT?9N D G GETADO
|
|---|
| 158 | . S BMXPIEN=$$PATSSN(BMXPAT)
|
|---|
| 159 | I BMXPAT?1.6N D G GETADO
|
|---|
| 160 | . S BMXPIEN=$$PATCHT(.BMXPIEN,BMXPAT)
|
|---|
| 161 | GETADO I $G(BMXPIEN),'$G(BMXPATS) D PATADO(.BMXPIEN)
|
|---|
| 162 | S BMXRET=BMXRET_$C(31)_$G(BMXERR)
|
|---|
| 163 | K BMXPAT,BMXPIEN,BMXCNT,BMXDA,BMXIEN,BMXPATE,BMXNM,BMXDB,BMXSX,BMXCT,BMXSSN
|
|---|
| 164 | K BMXPATS
|
|---|
| 165 | Q
|
|---|
| 166 | ;
|
|---|
| 167 | PATSSN(PAT) ;-- look up by ssn
|
|---|
| 168 | S BMXPIEN=$O(^DPT("SSN",PAT,0))
|
|---|
| 169 | S BMXPIEN(1)=BMXPIEN
|
|---|
| 170 | Q $G(BMXPIEN)
|
|---|
| 171 | ;
|
|---|
| 172 | PATCHT(BMXPIEN,HRN) ;-- lookup by chart
|
|---|
| 173 | N BMXCNT
|
|---|
| 174 | S BMXCNT=0,BMXPATE=0,BMXMCNT=0,BMXPIEN=""
|
|---|
| 175 | S BMXIEN=0 F S BMXIEN=$O(^AUPNPAT("D",HRN,BMXIEN)) Q:'BMXIEN D I BMXPIEN Q
|
|---|
| 176 | . I '$D(^AUPNPAT("D",HRN,BMXIEN,DUZ(2))) Q
|
|---|
| 177 | . 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!
|
|---|
| 178 | . S BMXPIEN=BMXIEN
|
|---|
| 179 | . S BMXCNT=BMXCNT+1
|
|---|
| 180 | . S:'$D(BMXPIEN(BMXCNT)) BMXPIEN(BMXCNT)=0
|
|---|
| 181 | . S BMXPIEN(BMXCNT)=BMXPIEN
|
|---|
| 182 | . Q
|
|---|
| 183 | Q BMXPIEN
|
|---|
| 184 | ;
|
|---|
| 185 | PATDOB(BMXPATE,PAT) ;-- lookup by DOB
|
|---|
| 186 | N BMXCNT
|
|---|
| 187 | S BMXCNT=0,BMXPATE=0
|
|---|
| 188 | S BMXIEN=0
|
|---|
| 189 | F S BMXIEN=$O(^DPT("ADOB",PAT,BMXIEN)) Q:'BMXIEN D
|
|---|
| 190 | . S:'$D(BMXPATE(BMXCNT)) BMXPATE(BMXCNT)=0
|
|---|
| 191 | . S BMXCNT=BMXCNT+1,BMXPATE=1
|
|---|
| 192 | . S BMXPATE(BMXCNT)=BMXIEN
|
|---|
| 193 | . Q
|
|---|
| 194 | S BMXPATE=BMXCNT
|
|---|
| 195 | Q $G(BMXPATE)
|
|---|
| 196 | ;
|
|---|
| 197 | PATNAM(BMXPATE,PAT,NPAT) ;lookup by name
|
|---|
| 198 | S BMXCNT=0,BMXPATE=0
|
|---|
| 199 | N BMXLEN
|
|---|
| 200 | S BMXLEN=$L(PAT)
|
|---|
| 201 | S BMXNAM=PAT
|
|---|
| 202 | S BMXNAM=$$BEGIN(PAT)
|
|---|
| 203 | I $G(NPAT)]"" S BMXNAM=NPAT
|
|---|
| 204 | F S BMXNAM=$O(^DPT("B",BMXNAM)) Q:BMXNAM=""!($E(BMXNAM,1,BMXLEN)'=PAT)!(BMXCNT>BMXMT) D
|
|---|
| 205 | . S BMXIEN=0 F S BMXIEN=$O(^DPT("B",BMXNAM,BMXIEN)) Q:'BMXIEN D
|
|---|
| 206 | .. Q:$O(^DPT("B",BMXNAM,BMXIEN,0)) ;cmi/maw 4/25/2005 don't get aliases
|
|---|
| 207 | .. S BMXCNT=BMXCNT+1
|
|---|
| 208 | .. S:'$D(BMXPATE(BMXCNT)) BMXPATE(BMXCNT)=0
|
|---|
| 209 | .. S BMXPATE(BMXCNT)=BMXIEN
|
|---|
| 210 | S BMXPATE=BMXCNT
|
|---|
| 211 | Q $G(BMXPATE)
|
|---|
| 212 | ;
|
|---|
| 213 | BEGIN(PT) ;-- get begin point
|
|---|
| 214 | N BMXPDA,BMXPIEN,BMXPCNT
|
|---|
| 215 | S BMXPCNT=0
|
|---|
| 216 | S BMXPDA=PT
|
|---|
| 217 | I $O(^DPT("B",BMXPDA,0)) D
|
|---|
| 218 | . S BMXPDA=$O(^DPT("B",BMXPDA),-1)
|
|---|
| 219 | F S BMXPDA=$O(^DPT("B",BMXPDA)) Q
|
|---|
| 220 | I $G(BMXPDA)="" Q ""
|
|---|
| 221 | Q $O(^DPT("B",BMXPDA),-1)
|
|---|
| 222 | ;
|
|---|
| 223 | PATADO(PIEN) ;-- ado return
|
|---|
| 224 | I '$G(DUZ(2)) Q ; DIVISION
|
|---|
| 225 | S BMXCNTR=0
|
|---|
| 226 | S BMXDA=0 F S BMXDA=$O(PIEN(BMXDA)) Q:'BMXDA D
|
|---|
| 227 | . S BMXCNTR=BMXCNTR+1
|
|---|
| 228 | . S BMXPI=$G(PIEN(BMXDA))
|
|---|
| 229 | . I '$D(^AUPNPAT(BMXPI,41,DUZ(2),0)) Q ; PATIENT NOT REGISTERED IN THE CURRENT DIVISION
|
|---|
| 230 | . S BMXNM=$P($G(^DPT(BMXPI,0)),U)
|
|---|
| 231 | . S BMXDB=$$FMTE^XLFDT($P($G(^DPT(BMXPI,0)),U,3))
|
|---|
| 232 | . S BMXSX=$P($G(^DPT(BMXPI,0)),U,2)
|
|---|
| 233 | . S BMXCT=$$HRN^AUPNPAT(BMXPI,DUZ(2))
|
|---|
| 234 | . S BMXSSN=$P($G(^DPT(BMXPI,0)),U,9)
|
|---|
| 235 | . S BMXUPD=$P($G(^AUPNPAT(BMXPI,0)),U,3)
|
|---|
| 236 | . S BMXELG=$$GET1^DIQ(9000001,BMXPI,1111) ;cmi/maw 5/17/2007 added class/ben for status bar
|
|---|
| 237 | . S BMXAGE=$$AGE^AUPNPAT(BMXPI,DT)
|
|---|
| 238 | . S BMXI=BMXI+1
|
|---|
| 239 | . 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)
|
|---|
| 240 | Q
|
|---|
| 241 | ;
|
|---|
| 242 | BMXCCXT(RESULT,XOPTION) ;creates context for the passed in option
|
|---|
| 243 | N XWB1,%,IEN,SIEN,OK,OPTION
|
|---|
| 244 | S RESULT=0
|
|---|
| 245 | S OPTION=$$DECRYP^XUSRB1(XOPTION) ;S:OPTION="" OPTION="\"
|
|---|
| 246 | I $E(OPTION,1,3)="BMX" S RESULT=1 Q ; NO RESTRICTIONS FOR BMX CONTEXT FOR THIS PORT
|
|---|
| 247 | K XQY0,XQY
|
|---|
| 248 | I OPTION="" S XQY=0,XQY0="" Q ;delete context if "" passed in N PORT
|
|---|
| 249 | ;
|
|---|
| 250 | ; Following lines are addition for 4.1000; GT.M does not use BMXMON
|
|---|
| 251 | D:^%ZOSF("OS")["OpenM" ; Doesn't apply to GT.M; Only Cache
|
|---|
| 252 | . S PORT=+$P($P,"|",3) I 'PORT Q
|
|---|
| 253 | . S IEN=$O(^BMXMON("B",PORT,0)) I 'IEN Q
|
|---|
| 254 | . I '$O(^BMXMON(IEN,1,0)) G BC1 ; NO RESTRICTIONS ON CONTEXT FOR THIS PORT
|
|---|
| 255 | . S OK=0,CIEN=0
|
|---|
| 256 | . F S CIEN=$O(^BMXMON(IEN,1,CIEN)) Q:'CIEN D I OK Q
|
|---|
| 257 | . . S %=$P($G(^BMXMON(IEN,1,CIEN,0)),U) I '% Q
|
|---|
| 258 | . . S %=$P($G(^DIC(19,%,0)),U) I %="" Q
|
|---|
| 259 | . . I %=OPTION S OK=1
|
|---|
| 260 | . . Q
|
|---|
| 261 | . I 'OK S (XWBSEC,RESULT)="The context '"_OPTION_"' is not registered with port "_PORT_"." Q
|
|---|
| 262 | BC1 S XWB1=$$OPTLK^XQCS(OPTION)
|
|---|
| 263 | I XWB1="" S (XWBSEC,RESULT)="The context '"_OPTION_"' does not exist on server." Q ;P10
|
|---|
| 264 | S RESULT=$$CHK^XQCS(DUZ,XWB1)
|
|---|
| 265 | ;Access or programmer
|
|---|
| 266 | BC2 I RESULT!$$KCHK^XUSRB("XUPROGMODE") S XQY0=OPTION,XQY=XWB1,RESULT=1 Q
|
|---|
| 267 | S XWBSEC=RESULT
|
|---|
| 268 | Q
|
|---|
| 269 | ;
|
|---|
| 270 | CVC(OUT,IN) ; EP - RPC: BMX CVC ; CHECK VERIFY CODE (SEE CVC^XUSRB)
|
|---|
| 271 | S OUT(0)=99,OUT(1)="INVALID PARAMETERS"
|
|---|
| 272 | I $L(IN)
|
|---|
| 273 | E Q
|
|---|
| 274 | N AV,EAC,EOVC,ENVC,USER,AC,OVC,NVC,EVC,NVC,X,Y,Z,%,RET,U
|
|---|
| 275 | S U="^",RET(0)="",RET(1)=""
|
|---|
| 276 | S AV=$$DECRYP^XUSRB1(IN) I AV="" Q
|
|---|
| 277 | S AC=$P(AV,";")
|
|---|
| 278 | S X=$$EN^XUSHSH(AC)
|
|---|
| 279 | S USER=$O(^VA(200,"A",X,0)) I 'USER Q
|
|---|
| 280 | S @$C(68,85,90)=USER
|
|---|
| 281 | S OVC=$P(AV,";",2) I OVC="" Q
|
|---|
| 282 | S NVC=$P(AV,";",3) I NVC="" Q
|
|---|
| 283 | S EOVC=$$ENCRYP^XUSRB1(OVC)
|
|---|
| 284 | S ENVC=$$ENCRYP^XUSRB1(NVC)
|
|---|
| 285 | D CVC^XUSRB(.RET,(ENVC_U_EOVC))
|
|---|
| 286 | M OUT=RET
|
|---|
| 287 | Q
|
|---|
| 288 | ;
|
|---|
| 289 | TEST ; TEST CVC
|
|---|
| 290 | N DUZ,IN
|
|---|
| 291 | S IN=$$ENCRYP^XUSRB1("GREG4330;IRA-1727;IRA-1727")
|
|---|
| 292 | D CVC^BMXRPC10(.OUT,IN) W !,$G(OUT(0))," - ",$G(OUT(1))
|
|---|
| 293 | Q
|
|---|
| 294 | ;
|
|---|
