VIAA1P3 ;ALB/CR - POST INIT FOR PATCH 3 OF RTLS ;5/4/16 9:55am
;;1.0;RTLS;**3**;April 22, 2013;Build 20
Q
POST ; Add the TABLE of remote procedure calls to common RTLS menu in VistA.
; Check the setup for a server and service for RTLS. If they exist,
; get out and pass the information to the installation log.
; Otherwise add the web server and service to call Mule in RTLS.
;
D BMES^XPDUTL(" POST-INIT: Starting Post-Install of Patch VIAA*1.0*3...")
D REGRPC
D BMES^XPDUTL(" ...Menu option 'VIAA01 RTLS RPC MENU' is now set up with new entries.")
;
D BMES^XPDUTL("")
I $D(^XOB(18.02,"B","VIAA VISTA TRIGGER SERVICE")) D BMES^XPDUTL(" ...found a trigger service, checking for a trigger server....") D POST1 Q
E D BMES^XPDUTL(" Adding a new web service, please wait...")
;
N CONTEXT,CURRDT,DA,DIC,DLAYGO,FDA
N SVCNAME,SERVER,PORT,SSL,STATUS,TYPE,X,Y
S CURRDT=$$NOW^XLFDT
S DIC(0)="L",DLAYGO=18.02,DIC="^XOB(18.02,"
S SVCNAME="VIAA VISTA TRIGGER SERVICE",TYPE=2
S CONTEXT="esb/assettrax/services/vistatrigger"
S X=SVCNAME
D FILE^DICN
S DA=+Y
L +^XOB(18.02,DA):5 I '$T D BMES^XPDUTL(" ...cannot lock file #18.02 - try later.") Q
S FDA(18.02,DA_",",.02)=TYPE
S FDA(18.02,DA_",",200)=CONTEXT
S FDA(18.02,DA_",",.03)=CURRDT
D UPDATE^DIE("","FDA","ERR")
L -^XOB(18.02,DA)
D CLEAN^DILF
D BMES^XPDUTL(" ...new web service "_SVCNAME_" added.")
D POST1
Q
;
POST1 ;
I $D(^XOB(18.12,"B","VIAA VISTA TRIGGER SERVER")) D BMES^XPDUTL(" ...found a trigger server - nothing else to do, quitting!") Q
N DEFHTTPT,LOGIN,MULT,SVCPTR,SSL,SSLCFIG
D BMES^XPDUTL(" Adding a new web server, please wait...")
S DIC(0)="L",DLAYGO=18.12,DIC="^XOB(18.12,"
S SERVER="VIAA VISTA TRIGGER SERVER",PORT=443
S SVCPTR=+$O(^XOB(18.02,"B","VIAA VISTA TRIGGER SERVICE","")) ; need pointer for later use
S STATUS=1,SSL=1,LOGIN=1,SSLCFIG="RTLS_CLIENT"
S DEFHTTPT=30 ; default http timeout
S X=SERVER
D FILE^DICN
S DA=+Y
L +^XOB(18.12,DA):5 I '$T D BMES^XPDUTL(" ...cannot lock file #18.12 - try later.") Q
S FDA(18.12,DA_",",.03)=PORT
S FDA(18.12,DA_",",.06)=STATUS
S FDA(18.12,DA_",",.07)=DEFHTTPT
S FDA(18.12,DA_",",1.01)=LOGIN
S FDA(18.12,DA_",",3.01)=SSL
S FDA(18.12,DA_",",3.02)=SSLCFIG
S FDA(18.12,DA_",",3.03)=PORT
D UPDATE^DIE("","FDA","")
D CLEAN^DILF
; add to multiple 100
S MULT(1,18.121,"+1,"_DA_",",.01)=SVCPTR
S MULT(1,18.121,"+1,"_DA_",",.06)=STATUS
D UPDATE^DIE("","MULT(1)","")
L -^XOB(18.12,DA)
D CLEAN^DILF
D BMES^XPDUTL(" ...new web server "_SERVER_" added.")
D BMES^XPDUTL(" Please note: the web server just added will need a ")
D BMES^XPDUTL(" fully qualified domain name, username, and password.")
D BMES^XPDUTL(" The information will be available via secure communication later on.")
D BMES^XPDUTL(" Post-Install for Patch VIAA*1.0*3 Finished.")
Q
;
REGRPC ; register RPC
N I,J,X,Y,DIC,FDA,REGRPC,RPCIEN,OPTIEN,VIAAOPT
S VIAAOPT="VIAA01 RTLS RPC MENU"
F I=1:1 S J=$P($E($T(TABLE+I),2,40),";;",2),REGRPC=J D ADD Q:J=""
Q
;
ADD ;
S DIC(0)="I",X=REGRPC,DIC="^XWB(8994,"
D ^DIC Q:'(Y>0) S RPCIEN=+Y
D CLEAN^DILF
;
S DIC(0)="I",X=VIAAOPT,DIC="^DIC(19,"
D ^DIC Q:'(Y>0) S OPTIEN=+Y
D CLEAN^DILF
S FDA(19.05,"?+1,"_OPTIEN_",",.01)=RPCIEN
D UPDATE^DIE("","FDA","")
Q
;
TABLE ; list the RPCs to be added to the menu option
;;VIAA ENG ASSET MOVE
;;VIAA ENG GET CATEGORY
;;VIAA ENG GET DATA
;;VIAA ENG GET EQUIPMENT
;;VIAA ENG GET LOCATION
;;VIAA ENG GET PRIMARY STATION
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIAA1P3 3547 printed Apr 09, 2024@21:35:58 Page 2
VIAA1P3 ;ALB/CR - POST INIT FOR PATCH 3 OF RTLS ;5/4/16 9:55am
+1 ;;1.0;RTLS;**3**;April 22, 2013;Build 20
+2 QUIT
POST ; Add the TABLE of remote procedure calls to common RTLS menu in VistA.
+1 ; Check the setup for a server and service for RTLS. If they exist,
+2 ; get out and pass the information to the installation log.
+3 ; Otherwise add the web server and service to call Mule in RTLS.
+4 ;
+5 DO BMES^XPDUTL(" POST-INIT: Starting Post-Install of Patch VIAA*1.0*3...")
+6 DO REGRPC
+7 DO BMES^XPDUTL(" ...Menu option 'VIAA01 RTLS RPC MENU' is now set up with new entries.")
+8 ;
+9 DO BMES^XPDUTL("")
+10 IF $DATA(^XOB(18.02,"B","VIAA VISTA TRIGGER SERVICE"))
DO BMES^XPDUTL(" ...found a trigger service, checking for a trigger server....")
DO POST1
QUIT
+11 IF '$TEST
DO BMES^XPDUTL(" Adding a new web service, please wait...")
+12 ;
+13 NEW CONTEXT,CURRDT,DA,DIC,DLAYGO,FDA
+14 NEW SVCNAME,SERVER,PORT,SSL,STATUS,TYPE,X,Y
+15 SET CURRDT=$$NOW^XLFDT
+16 SET DIC(0)="L"
SET DLAYGO=18.02
SET DIC="^XOB(18.02,"
+17 SET SVCNAME="VIAA VISTA TRIGGER SERVICE"
SET TYPE=2
+18 SET CONTEXT="esb/assettrax/services/vistatrigger"
+19 SET X=SVCNAME
+20 DO FILE^DICN
+21 SET DA=+Y
+22 LOCK +^XOB(18.02,DA):5
IF '$TEST
DO BMES^XPDUTL(" ...cannot lock file #18.02 - try later.")
QUIT
+23 SET FDA(18.02,DA_",",.02)=TYPE
+24 SET FDA(18.02,DA_",",200)=CONTEXT
+25 SET FDA(18.02,DA_",",.03)=CURRDT
+26 DO UPDATE^DIE("","FDA","ERR")
+27 LOCK -^XOB(18.02,DA)
+28 DO CLEAN^DILF
+29 DO BMES^XPDUTL(" ...new web service "_SVCNAME_" added.")
+30 DO POST1
+31 QUIT
+32 ;
POST1 ;
+1 IF $DATA(^XOB(18.12,"B","VIAA VISTA TRIGGER SERVER"))
DO BMES^XPDUTL(" ...found a trigger server - nothing else to do, quitting!")
QUIT
+2 NEW DEFHTTPT,LOGIN,MULT,SVCPTR,SSL,SSLCFIG
+3 DO BMES^XPDUTL(" Adding a new web server, please wait...")
+4 SET DIC(0)="L"
SET DLAYGO=18.12
SET DIC="^XOB(18.12,"
+5 SET SERVER="VIAA VISTA TRIGGER SERVER"
SET PORT=443
+6 ; need pointer for later use
SET SVCPTR=+$ORDER(^XOB(18.02,"B","VIAA VISTA TRIGGER SERVICE",""))
+7 SET STATUS=1
SET SSL=1
SET LOGIN=1
SET SSLCFIG="RTLS_CLIENT"
+8 ; default http timeout
SET DEFHTTPT=30
+9 SET X=SERVER
+10 DO FILE^DICN
+11 SET DA=+Y
+12 LOCK +^XOB(18.12,DA):5
IF '$TEST
DO BMES^XPDUTL(" ...cannot lock file #18.12 - try later.")
QUIT
+13 SET FDA(18.12,DA_",",.03)=PORT
+14 SET FDA(18.12,DA_",",.06)=STATUS
+15 SET FDA(18.12,DA_",",.07)=DEFHTTPT
+16 SET FDA(18.12,DA_",",1.01)=LOGIN
+17 SET FDA(18.12,DA_",",3.01)=SSL
+18 SET FDA(18.12,DA_",",3.02)=SSLCFIG
+19 SET FDA(18.12,DA_",",3.03)=PORT
+20 DO UPDATE^DIE("","FDA","")
+21 DO CLEAN^DILF
+22 ; add to multiple 100
+23 SET MULT(1,18.121,"+1,"_DA_",",.01)=SVCPTR
+24 SET MULT(1,18.121,"+1,"_DA_",",.06)=STATUS
+25 DO UPDATE^DIE("","MULT(1)","")
+26 LOCK -^XOB(18.12,DA)
+27 DO CLEAN^DILF
+28 DO BMES^XPDUTL(" ...new web server "_SERVER_" added.")
+29 DO BMES^XPDUTL(" Please note: the web server just added will need a ")
+30 DO BMES^XPDUTL(" fully qualified domain name, username, and password.")
+31 DO BMES^XPDUTL(" The information will be available via secure communication later on.")
+32 DO BMES^XPDUTL(" Post-Install for Patch VIAA*1.0*3 Finished.")
+33 QUIT
+34 ;
REGRPC ; register RPC
+1 NEW I,J,X,Y,DIC,FDA,REGRPC,RPCIEN,OPTIEN,VIAAOPT
+2 SET VIAAOPT="VIAA01 RTLS RPC MENU"
+3 FOR I=1:1
SET J=$PIECE($EXTRACT($TEXT(TABLE+I),2,40),";;",2)
SET REGRPC=J
DO ADD
if J=""
QUIT
+4 QUIT
+5 ;
ADD ;
+1 SET DIC(0)="I"
SET X=REGRPC
SET DIC="^XWB(8994,"
+2 DO ^DIC
if '(Y>0)
QUIT
SET RPCIEN=+Y
+3 DO CLEAN^DILF
+4 ;
+5 SET DIC(0)="I"
SET X=VIAAOPT
SET DIC="^DIC(19,"
+6 DO ^DIC
if '(Y>0)
QUIT
SET OPTIEN=+Y
+7 DO CLEAN^DILF
+8 SET FDA(19.05,"?+1,"_OPTIEN_",",.01)=RPCIEN
+9 DO UPDATE^DIE("","FDA","")
+10 QUIT
+11 ;
TABLE ; list the RPCs to be added to the menu option
+1 ;;VIAA ENG ASSET MOVE
+2 ;;VIAA ENG GET CATEGORY
+3 ;;VIAA ENG GET DATA
+4 ;;VIAA ENG GET EQUIPMENT
+5 ;;VIAA ENG GET LOCATION
+6 ;;VIAA ENG GET PRIMARY STATION
