- 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 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