SDEC23 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
;
EVENT(SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) ;EP
;Raise event to interested clients
;Clients are listed in ^TMP("SDEC23",$J,"EVENT",EVENT_NAME,IP,PORT)
;SDECSIP and SDECSPT represent the sender's IP and PORT.
;The event will not be raised back to the sender if these are non-null
;
N POP,X
Q:'$D(^TMP("SDEC23",$J,"EVENT",SDECEVENT))
S SDECIP=0 F S SDECIP=$O(^TMP("SDEC23",$J,"EVENT",SDECEVENT,SDECIP)) Q:SDECIP="" D
. S SDECPORT=0 F S SDECPORT=$O(^TMP("SDEC23",$J,"EVENT",SDECEVENT,SDECIP,SDECPORT)) Q:'+SDECPORT D
. . I SDECIP=SDECSIP Q ;,SDECPORT=SDECSPT Q
. . D CALL^%ZISTCP(SDECIP,SDECPORT,5)
. . I POP K ^TMP("SDEC23",$J,"EVENT",SDECEVENT,SDECIP,SDECPORT) Q
. . ;U IO R X#3:5
. . I X'="ACK" K ^TMP("SDEC23",$J,"EVENT",SDECEVENT,SDECIP,SDECPORT) Q
. . S SDECPARAM=$S(SDECPARAM="":"",1:U_SDECPARAM)
. . U IO W SDECEVENT,SDECPARAM,!
. . D ^%ZISC
. . Q
. Q
Q
;
EVERR(SDECEVENT,SDECIP,SDECPORT) ;
;
Q:$G(SDECEVENT)=""
Q:$G(SDECIP)=""
Q:$G(SDECIP)=""
K ^TMP("SDEC23",$J,"EVENT",SDECEVENT,SDECIP,SDECPORT)
Q
;
REGET ;EP
;Error trap from REGEVNT
;
I '$D(SDECI) N SDECI S SDECI=999
S SDECI=SDECI+1
D REGERR(SDECI,99)
Q
;
REGERR(SDECI,SDECERID) ;Error processing
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECERID_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
;
REGEVENT(SDECY,SDECEVENT,SDECIP,SDECPORT) ;Called by client to inform VISTA server of client's interest in SDECEVENT
;REGEVENT(SDECY,SDECEVENT,SDECIP,SDECPORT) external parameter tag is in SDEC
;SDECEVENT - Event to register with VistA
;SDECIP - Client IP address
;SDECPORT - Client Port
;Returns RECORDSET with field ERRORID.
;If everything ok then ERRORID = 0;
;
N SDECI
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020ERRORID"_$C(30)
I '+SDECPORT D REGERR(SDECI,1) Q
I SDECIP="" D REGERR(SDECI,2) Q
S ^TMP("SDEC23",$J,"EVENT",SDECEVENT,SDECIP,SDECPORT)=""
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="0"_$C(30)_$C(31)
Q
;
UNREGEV(SDECY,SDECEVENT,SDECIP,SDECPORT) ;Called by client to Unregister client's interest in SDECEVENT
;UNREGEV(SDECY,SDECEVENT,SDECIP,SDECPORT) external parameter tag in SDEC
;Returns RECORDSET with field ERRORID.
;If everything ok then ERRORID = 0;
;
N SDECI
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020ERRORID"_$C(30)
I '+SDECPORT D REGERR(SDECI,1) Q
I SDECIP="" D REGERR(SDECI,2) Q
K ^TMP("SDEC23",$J,"EVENT",SDECEVENT,SDECIP,SDECPORT)
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="0"_$C(30)_$C(31)
Q
;
RAISEVNT(SDECY,SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) ;RAISE EVENT
;RAISEVNT(SDECY,SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) external parameter tag is in SDEC
;RPC Called to raise event SDECEVENT with parameter SDECPARAM
;SDECSIP and SDECSPT represent the sender's IP and PORT.
;If not null, these will prevent the event from being raised back
;to the sender.
;Returns a RECORDSET wit the field ERRORID.
;If everything ok then ERRORID = 0;
;
N SDECI
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="I00020ERRORID"_$C(30)
;
D EVENT(SDECEVENT,SDECPARAM,SDECSIP,SDECSPT)
;
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)="0"_$C(30)_$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC23 3439 printed Nov 22, 2024@18:00:17 Page 2
SDEC23 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
+5 ;
EVENT(SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) ;EP
+1 ;Raise event to interested clients
+2 ;Clients are listed in ^TMP("SDEC23",$J,"EVENT",EVENT_NAME,IP,PORT)
+3 ;SDECSIP and SDECSPT represent the sender's IP and PORT.
+4 ;The event will not be raised back to the sender if these are non-null
+5 ;
+6 NEW POP,X
+7 if '$DATA(^TMP("SDEC23",$JOB,"EVENT",SDECEVENT))
QUIT
+8 SET SDECIP=0
FOR
SET SDECIP=$ORDER(^TMP("SDEC23",$JOB,"EVENT",SDECEVENT,SDECIP))
if SDECIP=""
QUIT
Begin DoDot:1
+9 SET SDECPORT=0
FOR
SET SDECPORT=$ORDER(^TMP("SDEC23",$JOB,"EVENT",SDECEVENT,SDECIP,SDECPORT))
if '+SDECPORT
QUIT
Begin DoDot:2
+10 ;,SDECPORT=SDECSPT Q
IF SDECIP=SDECSIP
QUIT
+11 DO CALL^%ZISTCP(SDECIP,SDECPORT,5)
+12 IF POP
KILL ^TMP("SDEC23",$JOB,"EVENT",SDECEVENT,SDECIP,SDECPORT)
QUIT
+13 ;U IO R X#3:5
+14 IF X'="ACK"
KILL ^TMP("SDEC23",$JOB,"EVENT",SDECEVENT,SDECIP,SDECPORT)
QUIT
+15 SET SDECPARAM=$SELECT(SDECPARAM="":"",1:U_SDECPARAM)
+16 USE IO
WRITE SDECEVENT,SDECPARAM,!
+17 DO ^%ZISC
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
EVERR(SDECEVENT,SDECIP,SDECPORT) ;
+1 ;
+2 if $GET(SDECEVENT)=""
QUIT
+3 if $GET(SDECIP)=""
QUIT
+4 if $GET(SDECIP)=""
QUIT
+5 KILL ^TMP("SDEC23",$JOB,"EVENT",SDECEVENT,SDECIP,SDECPORT)
+6 QUIT
+7 ;
REGET ;EP
+1 ;Error trap from REGEVNT
+2 ;
+3 IF '$DATA(SDECI)
NEW SDECI
SET SDECI=999
+4 SET SDECI=SDECI+1
+5 DO REGERR(SDECI,99)
+6 QUIT
+7 ;
REGERR(SDECI,SDECERID) ;Error processing
+1 SET SDECI=SDECI+1
+2 SET ^TMP("SDEC",$JOB,SDECI)=SDECERID_$CHAR(30)
+3 SET SDECI=SDECI+1
+4 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+5 QUIT
+6 ;
+7 ;
REGEVENT(SDECY,SDECEVENT,SDECIP,SDECPORT) ;Called by client to inform VISTA server of client's interest in SDECEVENT
+1 ;REGEVENT(SDECY,SDECEVENT,SDECIP,SDECPORT) external parameter tag is in SDEC
+2 ;SDECEVENT - Event to register with VistA
+3 ;SDECIP - Client IP address
+4 ;SDECPORT - Client Port
+5 ;Returns RECORDSET with field ERRORID.
+6 ;If everything ok then ERRORID = 0;
+7 ;
+8 NEW SDECI
+9 SET SDECI=0
+10 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+11 KILL @SDECY
+12 SET ^TMP("SDEC",$JOB,0)="I00020ERRORID"_$CHAR(30)
+13 IF '+SDECPORT
DO REGERR(SDECI,1)
QUIT
+14 IF SDECIP=""
DO REGERR(SDECI,2)
QUIT
+15 SET ^TMP("SDEC23",$JOB,"EVENT",SDECEVENT,SDECIP,SDECPORT)=""
+16 ;
+17 SET SDECI=SDECI+1
+18 SET ^TMP("SDEC",$JOB,SDECI)="0"_$CHAR(30)_$CHAR(31)
+19 QUIT
+20 ;
UNREGEV(SDECY,SDECEVENT,SDECIP,SDECPORT) ;Called by client to Unregister client's interest in SDECEVENT
+1 ;UNREGEV(SDECY,SDECEVENT,SDECIP,SDECPORT) external parameter tag in SDEC
+2 ;Returns RECORDSET with field ERRORID.
+3 ;If everything ok then ERRORID = 0;
+4 ;
+5 NEW SDECI
+6 SET SDECI=0
+7 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+8 KILL @SDECY
+9 SET ^TMP("SDEC",$JOB,0)="I00020ERRORID"_$CHAR(30)
+10 IF '+SDECPORT
DO REGERR(SDECI,1)
QUIT
+11 IF SDECIP=""
DO REGERR(SDECI,2)
QUIT
+12 KILL ^TMP("SDEC23",$JOB,"EVENT",SDECEVENT,SDECIP,SDECPORT)
+13 ;
+14 SET SDECI=SDECI+1
+15 SET ^TMP("SDEC",$JOB,SDECI)="0"_$CHAR(30)_$CHAR(31)
+16 QUIT
+17 ;
RAISEVNT(SDECY,SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) ;RAISE EVENT
+1 ;RAISEVNT(SDECY,SDECEVENT,SDECPARAM,SDECSIP,SDECSPT) external parameter tag is in SDEC
+2 ;RPC Called to raise event SDECEVENT with parameter SDECPARAM
+3 ;SDECSIP and SDECSPT represent the sender's IP and PORT.
+4 ;If not null, these will prevent the event from being raised back
+5 ;to the sender.
+6 ;Returns a RECORDSET wit the field ERRORID.
+7 ;If everything ok then ERRORID = 0;
+8 ;
+9 NEW SDECI
+10 SET SDECI=0
+11 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+12 KILL @SDECY
+13 SET ^TMP("SDEC",$JOB,0)="I00020ERRORID"_$CHAR(30)
+14 ;
+15 DO EVENT(SDECEVENT,SDECPARAM,SDECSIP,SDECSPT)
+16 ;
+17 SET SDECI=SDECI+1
+18 SET ^TMP("SDEC",$JOB,SDECI)="0"_$CHAR(30)_$CHAR(31)
+19 QUIT
