- 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 Feb 18, 2025@23:59:39 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