Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUINP337

XUINP337.m

Go to the documentation of this file.
  1. XUINP337 ;ISF/RWF - PATCH XU*8*337 POST INIT. ;08/08/2005 09:04
  1. ;;8.0;KERNEL;**337**;Jul 10, 1995
  1. POST ;Post Install
  1. D PST1,PST2
  1. Q
  1. ;
  1. TEST ;Test the get part
  1. N T1,T2 S (APP1,APP2)=""
  1. D HOME^%ZIS S T1=$H
  1. D GET,CLOSE^%ZISTCP
  1. S T2=$H
  1. W !,"Return data was "_$S(($L(APP1)+$L(APP2))=256:"OK",1:"Missing")
  1. W !,"Call took ",$P(T2,",",2)-$P(T1,",",2)," seconds"
  1. Q
  1. ;
  1. PST1 ;Get the app-code
  1. N APP1,APP2,CCOW,RET,X,XWBTIME
  1. D GETAPC
  1. I $L($G(RET(0))),$L($G(RET(1))) Q ;Already have APC
  1. D BMES^XPDUTL("Get CCOW parameter.")
  1. S CCOW="XUS CCOW VAULT PARAM",(APP1,APP2)=""
  1. D GET,CLOSE^%ZISTCP
  1. D FILE
  1. D GETAPC
  1. I '$D(RET(0))!'$D(RET(1)) D FAIL
  1. E D BMES^XPDUTL("Set CCOW parameter.")
  1. Q
  1. ;
  1. GET ;Get the codes
  1. N SITE,XWBTDEV,XWBRBUF,XWBDEBUG,$ES,$ET
  1. S $ETRAP="D ERR^XUINP337"
  1. S XWBTIME=30,XWBTIME(1)=3
  1. S SITE=$$KSP^XUPARAM("WHERE")
  1. ;Get the data from the FO-oakland ISC account.
  1. D CALL^%ZISTCP("127.0.0.1",33865) G:POP FAIL
  1. U IO S XWBTDEV=IO,XWBRBUF="",XWBDEBUG=0
  1. W "[SSO]3-"_$E(1000+$L(SITE),2,4)_SITE,@IOF
  1. S X=+$$BREAD^XWBRW(3) I X'>0 Q
  1. S APP1=$$BREAD^XWBRW(X)
  1. S X=+$$BREAD^XWBRW(3) I X'>0 Q
  1. S APP2=$$BREAD^XWBRW(X)
  1. S X=$$BREAD^XWBRW(1)
  1. Q
  1. ;
  1. FAIL ;Tell user APPCODE failed
  1. D BMES^XPDUTL("Failed to set CCOW parameter.")
  1. Q
  1. ;
  1. ERR ;
  1. D ^%ZTER,UNWIND^%ZTER
  1. ;
  1. FILE ;
  1. I '$L($G(APP1))!'$L($G(APP2)) D ^%ZTER Q
  1. D ADD^XPAR("SYS",CCOW,0,APP1,.ERR)
  1. D ADD^XPAR("SYS",CCOW,1,APP2,.ERR)
  1. Q
  1. ;
  1. GETAPC ;Test the appcode
  1. K RET
  1. S RET(0)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",0,"Q")
  1. S RET(1)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",1,"Q")
  1. Q
  1. PST2 ;Set default CCOW token timeout
  1. N DIE,DIC,DR,DA
  1. S DIE="^XTV(8989.3,",DA=1,DR="30.1////5400" D ^DIE
  1. Q