- 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 Feb 18, 2025@23:36:12 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