MDRPCOU ; HOIFO/DP - Object RPCs (TMDUser) ; [01-09-2003 15:21]
;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
; Integration Agreements:
; IA# 2263 [Supported] XPAR parameter calls.
; IA# 2541 [Supported] Call to XUPARAM.
; IA# 2241 [Supported] Call to XUSRB1.
; IA# 10045 [Supported] Call to XUSHSHP.
; IA# 10076 [Supported] Direct read of XUSEC
; IA# 10097 [Supported] Access to rtn %ZOSV
;
ESIG ; [Procedure] Verify users electronic signature
I $G(DATA)="" D Q
.S @RESULTS@(0)="-1^Must supply electronic signature code"
S X=$$DECRYP^XUSRB1(DATA)
D HASH^XUSHSHP
I X'=$$GET1^DIQ(200,DUZ_",",20.4,"I") S @RESULTS@(0)="-1^E-Sig Invalid^"
E S @RESULTS@(0)="1^E-Sig Verifed^"_X
Q
;
GETPROC ; [Procedure] Get procedures access list
NEW MDTMP
S DATA=$G(DATA,DUZ)_";VA(200,"
D GETLST^XPAR(.MDTMP,DATA,"MD PROCEDURE ACCESS","Q")
F X=0:0 S X=$O(MDTMP(X)) Q:'X D:$P(MDTMP(X),U,2)
.S Y=$O(@RESULTS@(""),-1)+1
.S @RESULTS@(Y)=+MDTMP(X)
S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
Q
;
RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC Call
; Input parameters
; 1. RESULTS [Literal/Required] No description
; 2. OPTION [Literal/Required] No description
; 3. DATA [Literal/Required] No description
;
; RPC: [MD TMDUSER]
S RESULTS=$NA(^TMP($J)) K @RESULTS
D:$T(@OPTION)]"" @OPTION
D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDUSER","MDRPCOU",OPTION)
D CLEAN^DILF
Q
;
SIGNON ; [Procedure] Returns sign-on information after Broker.Connected := True
S @RESULTS@(0)=DUZ
S @RESULTS@(1)=$$GET1^DIQ(200,DUZ_",",.01) ; Name
S @RESULTS@(2)=+$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE")) ;Domain
S @RESULTS@(3)=$$KSP^XUPARAM("WHERE") ; Domain Name
S @RESULTS@(4)=+$G(DUZ(2)) ; Division IEN
S @RESULTS@(5)=$S(+$G(DUZ(2)):$$GET1^DIQ(4,DUZ(2)_",",.01),1:"UNKNOWN")
S @RESULTS@(6)=$D(^XUSEC("MD MANAGER",DUZ))#2
S @RESULTS@(7)=$$GET1^DIQ(200,DUZ_",",8)
S @RESULTS@(8)="" ; Obsolete Wizard Flag
S @RESULTS@(9)=$G(DTIME,300)
D GETENV^%ZOSV
S @RESULTS@(10)=$P(Y,U,1,3)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCOU 2034 printed Apr 09, 2024@20:48:17 Page 2
MDRPCOU ; HOIFO/DP - Object RPCs (TMDUser) ; [01-09-2003 15:21]
+1 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004
+2 ; Integration Agreements:
+3 ; IA# 2263 [Supported] XPAR parameter calls.
+4 ; IA# 2541 [Supported] Call to XUPARAM.
+5 ; IA# 2241 [Supported] Call to XUSRB1.
+6 ; IA# 10045 [Supported] Call to XUSHSHP.
+7 ; IA# 10076 [Supported] Direct read of XUSEC
+8 ; IA# 10097 [Supported] Access to rtn %ZOSV
+9 ;
ESIG ; [Procedure] Verify users electronic signature
+1 IF $GET(DATA)=""
Begin DoDot:1
+2 SET @RESULTS@(0)="-1^Must supply electronic signature code"
End DoDot:1
QUIT
+3 SET X=$$DECRYP^XUSRB1(DATA)
+4 DO HASH^XUSHSHP
+5 IF X'=$$GET1^DIQ(200,DUZ_",",20.4,"I")
SET @RESULTS@(0)="-1^E-Sig Invalid^"
+6 IF '$TEST
SET @RESULTS@(0)="1^E-Sig Verifed^"_X
+7 QUIT
+8 ;
GETPROC ; [Procedure] Get procedures access list
+1 NEW MDTMP
+2 SET DATA=$GET(DATA,DUZ)_";VA(200,"
+3 DO GETLST^XPAR(.MDTMP,DATA,"MD PROCEDURE ACCESS","Q")
+4 FOR X=0:0
SET X=$ORDER(MDTMP(X))
if 'X
QUIT
if $PIECE(MDTMP(X),U,2)
Begin DoDot:1
+5 SET Y=$ORDER(@RESULTS@(""),-1)+1
+6 SET @RESULTS@(Y)=+MDTMP(X)
End DoDot:1
+7 SET @RESULTS@(0)=+$ORDER(@RESULTS@(""),-1)
+8 QUIT
+9 ;
RPC(RESULTS,OPTION,DATA) ; [Procedure] Main RPC Call
+1 ; Input parameters
+2 ; 1. RESULTS [Literal/Required] No description
+3 ; 2. OPTION [Literal/Required] No description
+4 ; 3. DATA [Literal/Required] No description
+5 ;
+6 ; RPC: [MD TMDUSER]
+7 SET RESULTS=$NAME(^TMP($JOB))
KILL @RESULTS
+8 if $TEXT(@OPTION)]""
DO @OPTION
+9 if '$DATA(@RESULTS)
DO BADRPC^MDRPCU("MD TMDUSER","MDRPCOU",OPTION)
+10 DO CLEAN^DILF
+11 QUIT
+12 ;
SIGNON ; [Procedure] Returns sign-on information after Broker.Connected := True
+1 SET @RESULTS@(0)=DUZ
+2 ; Name
SET @RESULTS@(1)=$$GET1^DIQ(200,DUZ_",",.01)
+3 ;Domain
SET @RESULTS@(2)=+$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))
+4 ; Domain Name
SET @RESULTS@(3)=$$KSP^XUPARAM("WHERE")
+5 ; Division IEN
SET @RESULTS@(4)=+$GET(DUZ(2))
+6 SET @RESULTS@(5)=$SELECT(+$GET(DUZ(2)):$$GET1^DIQ(4,DUZ(2)_",",.01),1:"UNKNOWN")
+7 SET @RESULTS@(6)=$DATA(^XUSEC("MD MANAGER",DUZ))#2
+8 SET @RESULTS@(7)=$$GET1^DIQ(200,DUZ_",",8)
+9 ; Obsolete Wizard Flag
SET @RESULTS@(8)=""
+10 SET @RESULTS@(9)=$GET(DTIME,300)
+11 DO GETENV^%ZOSV
+12 SET @RESULTS@(10)=$PIECE(Y,U,1,3)
+13 QUIT
+14 ;
