MDRPCOU.m

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 ---MDRPCOU   2034     printed  Apr 23, 2025@17:58:39                                                                                                                                                                                                     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      ;