source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUINP337.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1XUINP337 ;ISF/RWF - PATCH XU*8*337 POST INIT. ;08/08/2005 09:04
2 ;;8.0;KERNEL;**337**;Jul 10, 1995
3POST ;Post Install
4 D PST1,PST2
5 Q
6 ;
7TEST ;Test the get part
8 N T1,T2 S (APP1,APP2)=""
9 D HOME^%ZIS S T1=$H
10 D GET,CLOSE^%ZISTCP
11 S T2=$H
12 W !,"Return data was "_$S(($L(APP1)+$L(APP2))=256:"OK",1:"Missing")
13 W !,"Call took ",$P(T2,",",2)-$P(T1,",",2)," seconds"
14 Q
15 ;
16PST1 ;Get the app-code
17 N APP1,APP2,CCOW,RET,X,XWBTIME
18 D GETAPC
19 I $L($G(RET(0))),$L($G(RET(1))) Q ;Already have APC
20 D BMES^XPDUTL("Get CCOW parameter.")
21 S CCOW="XUS CCOW VAULT PARAM",(APP1,APP2)=""
22 D GET,CLOSE^%ZISTCP
23 D FILE
24 D GETAPC
25 I '$D(RET(0))!'$D(RET(1)) D FAIL
26 E D BMES^XPDUTL("Set CCOW parameter.")
27 Q
28 ;
29GET ;Get the codes
30 N SITE,XWBTDEV,XWBRBUF,XWBDEBUG,$ES,$ET
31 S $ETRAP="D ERR^XUINP337"
32 S XWBTIME=30,XWBTIME(1)=3
33 S SITE=$$KSP^XUPARAM("WHERE")
34 ;Get the data from the FO-oakland ISC account.
35 D CALL^%ZISTCP("10.6.21.15",33865) G:POP FAIL
36 U IO S XWBTDEV=IO,XWBRBUF="",XWBDEBUG=0
37 W "[SSO]3-"_$E(1000+$L(SITE),2,4)_SITE,@IOF
38 S X=+$$BREAD^XWBRW(3) I X'>0 Q
39 S APP1=$$BREAD^XWBRW(X)
40 S X=+$$BREAD^XWBRW(3) I X'>0 Q
41 S APP2=$$BREAD^XWBRW(X)
42 S X=$$BREAD^XWBRW(1)
43 Q
44 ;
45FAIL ;Tell user APPCODE failed
46 D BMES^XPDUTL("Failed to set CCOW parameter.")
47 Q
48 ;
49ERR ;
50 D ^%ZTER,UNWIND^%ZTER
51 ;
52FILE ;
53 I '$L($G(APP1))!'$L($G(APP2)) D ^%ZTER Q
54 D ADD^XPAR("SYS",CCOW,0,APP1,.ERR)
55 D ADD^XPAR("SYS",CCOW,1,APP2,.ERR)
56 Q
57 ;
58GETAPC ;Test the appcode
59 K RET
60 S RET(0)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",0,"Q")
61 S RET(1)=$$GET^XPAR("SYS","XUS CCOW VAULT PARAM",1,"Q")
62 Q
63PST2 ;Set default CCOW token timeout
64 N DIE,DIC,DR,DA
65 S DIE="^XTV(8989.3,",DA=1,DR="30.1////5400" D ^DIE
66 Q
Note: See TracBrowser for help on using the repository browser.