| 1 | MDRPCOU ; HOIFO/DP - Object RPCs (TMDUser) ; [01-09-2003 15:21]
|
|---|
| 2 | ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
|
|---|
| 3 | ; Integration Agreements:
|
|---|
| 4 | ; IA# 2263 [Supported] XPAR parameter calls.
|
|---|
| 5 | ; IA# 2541 [Supported] Call to XUPARAM.
|
|---|
| 6 | ; IA# 2241 [Supported] Call to XUSRB1.
|
|---|
| 7 | ; IA# 10045 [Supported] Call to XUSHSHP.
|
|---|
| 8 | ; IA# 10076 [Supported] Direct read of XUSEC
|
|---|
| 9 | ; IA# 10097 [Supported] Access to rtn %ZOSV
|
|---|
| 10 | ;
|
|---|
| 11 | ESIG ; [Procedure] Verify users electronic signature
|
|---|
| 12 | I $G(DATA)="" D Q
|
|---|
| 13 | .S @RESULTS@(0)="-1^Must supply electronic signature code"
|
|---|
| 14 | S X=$$DECRYP^XUSRB1(DATA)
|
|---|
| 15 | D HASH^XUSHSHP
|
|---|
| 16 | I X'=$$GET1^DIQ(200,DUZ_",",20.4,"I") S @RESULTS@(0)="-1^E-Sig Invalid^"
|
|---|
| 17 | E S @RESULTS@(0)="1^E-Sig Verifed^"_X
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | GETPROC ; [Procedure] Get procedures access list
|
|---|
| 21 | NEW MDTMP
|
|---|
| 22 | S DATA=$G(DATA,DUZ)_";VA(200,"
|
|---|
| 23 | D GETLST^XPAR(.MDTMP,DATA,"MD PROCEDURE ACCESS","Q")
|
|---|
| 24 | F X=0:0 S X=$O(MDTMP(X)) Q:'X D:$P(MDTMP(X),U,2)
|
|---|
| 25 | .S Y=$O(@RESULTS@(""),-1)+1
|
|---|
| 26 | .S @RESULTS@(Y)=+MDTMP(X)
|
|---|
| 27 | S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC Call
|
|---|
| 31 | ; Input parameters
|
|---|
| 32 | ; 1. RESULTS [Literal/Required] No description
|
|---|
| 33 | ; 2. OPTION [Literal/Required] No description
|
|---|
| 34 | ; 3. DATA [Literal/Required] No description
|
|---|
| 35 | ;
|
|---|
| 36 | ; RPC: [MD TMDUSER]
|
|---|
| 37 | S RESULTS=$NA(^TMP($J)) K @RESULTS
|
|---|
| 38 | D:$T(@OPTION)]"" @OPTION
|
|---|
| 39 | D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDUSER","MDRPCOU",OPTION)
|
|---|
| 40 | D CLEAN^DILF
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | SIGNON ; [Procedure] Returns sign-on information after Broker.Connected := True
|
|---|
| 44 | S @RESULTS@(0)=DUZ
|
|---|
| 45 | S @RESULTS@(1)=$$GET1^DIQ(200,DUZ_",",.01) ; Name
|
|---|
| 46 | S @RESULTS@(2)=+$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE")) ;Domain
|
|---|
| 47 | S @RESULTS@(3)=$$KSP^XUPARAM("WHERE") ; Domain Name
|
|---|
| 48 | S @RESULTS@(4)=+$G(DUZ(2)) ; Division IEN
|
|---|
| 49 | S @RESULTS@(5)=$S(+$G(DUZ(2)):$$GET1^DIQ(4,DUZ(2)_",",.01),1:"UNKNOWN")
|
|---|
| 50 | S @RESULTS@(6)=$D(^XUSEC("MD MANAGER",DUZ))#2
|
|---|
| 51 | S @RESULTS@(7)=$$GET1^DIQ(200,DUZ_",",8)
|
|---|
| 52 | S @RESULTS@(8)="" ; Obsolete Wizard Flag
|
|---|
| 53 | S @RESULTS@(9)=$G(DTIME,300)
|
|---|
| 54 | D GETENV^%ZOSV
|
|---|
| 55 | S @RESULTS@(10)=$P(Y,U,1,3)
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
