XUINP337 ;ISF/RWF - PATCH XU*8*337 POST INIT. ;08/08/2005 09:04
;;8.0;KERNEL;**337**;Jul 10, 1995
POST ;Post Install
D PST1,PST2
Q
;
TEST ;Test the get part
N T1,T2 S (APP1,APP2)=""
D HOME^%ZIS S T1=$H
D GET,CLOSE^%ZISTCP
S T2=$H
W !,"Return data was "_$S(($L(APP1)+$L(APP2))=256:"OK",1:"Missing")
W !,"Call took ",$P(T2,",",2)-$P(T1,",",2)," seconds"
Q
;
PST1 ;Get the app-code
N APP1,APP2,CCOW,RET,X,XWBTIME
D GETAPC
I $L($G(RET(0))),$L($G(RET(1))) Q ;Already have APC
D BMES^XPDUTL("Get CCOW parameter.")
S CCOW="XUS CCOW VAULT PARAM",(APP1,APP2)=""
D GET,CLOSE^%ZISTCP
D FILE
D GETAPC
I '$D(RET(0))!'$D(RET(1)) D FAIL
E D BMES^XPDUTL("Set CCOW parameter.")
Q
;
GET ;Get the codes
N SITE,XWBTDEV,XWBRBUF,XWBDEBUG,$ES,$ET
S $ETRAP="D ERR^XUINP337"
S XWBTIME=30,XWBTIME(1)=3
S SITE=$$KSP^XUPARAM("WHERE")
;Get the data from the FO-oakland ISC account.
D CALL^%ZISTCP("127.0.0.1",33865) G:POP FAIL
U IO S XWBTDEV=IO,XWBRBUF="",XWBDEBUG=0
W "[SSO]3-"_$E(1000+$L(SITE),2,4)_SITE,@IOF
S X=+$$BREAD^XWBRW(3) I X'>0 Q
S APP1=$$BREAD^XWBRW(X)
S X=+$$BREAD^XWBRW(3) I X'>0 Q
S APP2=$$BREAD^XWBRW(X)
S X=$$BREAD^XWBRW(1)
Q
;
FAIL ;Tell user APPCODE failed
D BMES^XPDUTL("Failed to set CCOW parameter.")
Q
;
ERR ;
D ^%ZTER,UNWIND^%ZTER
;
FILE ;
I '$L($G(APP1))!'$L($G(APP2)) D ^%ZTER Q
D ADD^XPAR("SYS",CCOW,0,APP1,.ERR)
D ADD^XPAR("SYS",CCOW,1,APP2,.ERR)
Q
;
GETAPC ;Test the appcode
K RET
S RET(0)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",0,"Q")
S RET(1)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",1,"Q")
Q
PST2 ;Set default CCOW token timeout
N DIE,DIC,DR,DA
S DIE="^XTV(8989.3,",DA=1,DR="30.1////5400" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUINP337 1727 printed Sep 23, 2025@19:45:59 Page 2
XUINP337 ;ISF/RWF - PATCH XU*8*337 POST INIT. ;08/08/2005 09:04
+1 ;;8.0;KERNEL;**337**;Jul 10, 1995
POST ;Post Install
+1 DO PST1
DO PST2
+2 QUIT
+3 ;
TEST ;Test the get part
+1 NEW T1,T2
SET (APP1,APP2)=""
+2 DO HOME^%ZIS
SET T1=$HOROLOG
+3 DO GET
DO CLOSE^%ZISTCP
+4 SET T2=$HOROLOG
+5 WRITE !,"Return data was "_$SELECT(($LENGTH(APP1)+$LENGTH(APP2))=256:"OK",1:"Missing")
+6 WRITE !,"Call took ",$PIECE(T2,",",2)-$PIECE(T1,",",2)," seconds"
+7 QUIT
+8 ;
PST1 ;Get the app-code
+1 NEW APP1,APP2,CCOW,RET,X,XWBTIME
+2 DO GETAPC
+3 ;Already have APC
IF $LENGTH($GET(RET(0)))
IF $LENGTH($GET(RET(1)))
QUIT
+4 DO BMES^XPDUTL("Get CCOW parameter.")
+5 SET CCOW="XUS CCOW VAULT PARAM"
SET (APP1,APP2)=""
+6 DO GET
DO CLOSE^%ZISTCP
+7 DO FILE
+8 DO GETAPC
+9 IF '$DATA(RET(0))!'$DATA(RET(1))
DO FAIL
+10 IF '$TEST
DO BMES^XPDUTL("Set CCOW parameter.")
+11 QUIT
+12 ;
GET ;Get the codes
+1 NEW SITE,XWBTDEV,XWBRBUF,XWBDEBUG,$ESTACK,$ETRAP
+2 SET $ETRAP="D ERR^XUINP337"
+3 SET XWBTIME=30
SET XWBTIME(1)=3
+4 SET SITE=$$KSP^XUPARAM("WHERE")
+5 ;Get the data from the FO-oakland ISC account.
+6 DO CALL^%ZISTCP("127.0.0.1",33865)
if POP
GOTO FAIL
+7 USE IO
SET XWBTDEV=IO
SET XWBRBUF=""
SET XWBDEBUG=0
+8 WRITE "[SSO]3-"_$EXTRACT(1000+$LENGTH(SITE),2,4)_SITE,@IOF
+9 SET X=+$$BREAD^XWBRW(3)
IF X'>0
QUIT
+10 SET APP1=$$BREAD^XWBRW(X)
+11 SET X=+$$BREAD^XWBRW(3)
IF X'>0
QUIT
+12 SET APP2=$$BREAD^XWBRW(X)
+13 SET X=$$BREAD^XWBRW(1)
+14 QUIT
+15 ;
FAIL ;Tell user APPCODE failed
+1 DO BMES^XPDUTL("Failed to set CCOW parameter.")
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
DO UNWIND^%ZTER
+2 ;
FILE ;
+1 IF '$LENGTH($GET(APP1))!'$LENGTH($GET(APP2))
DO ^%ZTER
QUIT
+2 DO ADD^XPAR("SYS",CCOW,0,APP1,.ERR)
+3 DO ADD^XPAR("SYS",CCOW,1,APP2,.ERR)
+4 QUIT
+5 ;
GETAPC ;Test the appcode
+1 KILL RET
+2 SET RET(0)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",0,"Q")
+3 SET RET(1)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",1,"Q")
+4 QUIT
PST2 ;Set default CCOW token timeout
+1 NEW DIE,DIC,DR,DA
+2 SET DIE="^XTV(8989.3,"
SET DA=1
SET DR="30.1////5400"
DO ^DIE
+3 QUIT
