SDEC23.m

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 ---SDEC23   3439     printed  Feb 19, 2025@00:16:42                                                                                                                                                                                                      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