source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQDX.m@ 1639

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1DVBHQDX ;ISC-ALBANY/PKE/PHH-HINQ IDCU,VBA diagnostic ; 3/23/06 7:56am
2 ;;4.0;HINQ;**9,12,33,34,49,57**;03/25/92
3EN S X="A" X ^%ZOSF("LPC") K X S U="^",DVBTSK=0 S:'$D(DTIME) DTIME=300 I $D(IO)<11 S IOP="HOME" D ^%ZIS K IOP
4 S:'$D(DVBSTN) DVBSTN=$P(^DVB(395,1,0),U,2) I 'DVBSTN W !!,"Station number not defined in HINQ Parameters file. " D EX1 Q
5 S DVBDXX=""
6 S DVBZ="HINQ"_DVBSTN_" "_"E00000000000000SS12345678NMTEST,HINQ/ABCD1234"
7 W !,"This test will take 30 seconds. No input is required or allowed.",!,"Responses are from the Frame Relay Network, or remote VBA computer."
8 W !,"Success in this test will return a message to the user"
9AGN U IO(0) W !!,"Do you wish to continue" S %=1 D YN^DICN
10 I %Y["?" G AGN
11 I %'=1 D EX1 Q
12 W !!
13 S DVBIDCU=^DVB(395,1,"HQVD")_"^"_$P(^("HQ"),"^",11)
14 S DVBLOG=$P(DVBIDCU,U),(DVBDEV,ION)=$P(DVBIDCU,U,4),DVBPU=$P(DVBIDCU,U,2),DVBID=$P(DVBPU,"-"),DVBPW=$P(DVBPU,"-",2)
15 I DVBLOG'?3U1"."4U W !,"IDCU ADDRESS not correct in HINQ Parameter file #395" H 2 G END
16 ;I '$L(DVBDEV) W !!,"DEVICE NAME not defined in HINQ DEVICE NAME of DVB #395" H 2 G END
17 ;I '$L(DVBID) W !,"HINQ IDCU User ID not defined in IDCU USERNAME-PASSWORD parameter." H 2 G END
18 ;I '$L(DVBPW) W !,"HINQ IDCU Password not defined in IDCU USERNAME-PASSWORD parameter." H 2 G END
19 I $P(DVBIDCU,"^",6) S DVBLOG="VHA"_$P(DVBLOG,"DMS",2)
20 ;U IO(0) W !,"HINQ device defined as ",DVBDEV,!!
21 ;with DVB*4*49 there will be only one server - message will be
22 ;"Connecting to VBA"
23 U IO(0) W !,"Connecting to VBA"
24 ;
25 S DVBIP=$P($G(^DVB(395,1,"HQIP")),"^")
26 I DVBIP,DVBIP?1.3N1P1.3N1P1.3N1P1.3N
27 E W:'DVBTSK !?3,"RDPC IP Address not defined or invalid in DVB parameter file #395" H 3 G EX
28 ;
29 N DVBPORT,DVBSTN
30 S DVBSTN=$P(^DVB(395,1,0),U,2)
31 S DVBPORT=$$PORT^DVBHQDL(DVBSTN)
32 D CALL^%ZISTCP(DVBIP,DVBPORT,"33")
33 I POP G BUSY
34 ;
35 S X=0 U IO X ^%ZOSF("EOFF"),^%ZOSF("TYPE-AHEAD"),^%ZOSF("RM") H 1 ;;;F Z=0:0 R *X:1 Q:'$T U IO(0) W $C(X) U IO
36 S C=0
37NAM ;;;U IO W $C(13)
38 ;
39HEL F Z2=1:1:50 U IO R X(Z2):1 U IO(0) W "." U IO H 1 I X(Z2)["**HELLO**" S DVBXM=1,DVBTSK=0,DVBABORT=0 U IO S DVBIO=IO,DVBJDX=1 D MES^DVBHQD1 S IO=DVBIO Q
40 I DVBLOG'["VHA" U IO W "$$$BYEF",$C(13) D DISP G EX
41 I DVBLOG["VHA" U IO W "$%$DIS",$C(13),! D DISP G EX
42 D DISP
43END F Z=1:1:30 I $D(X(Z)),X(Z)["???" U IO I DVBLOG'["VHA" W "BYEF",$C(13) Q
44 F Z=1:1:30 I $D(X(Z)),X(Z)["$%$" U IO I DVBLOG["VHA" W "DIS",$C(13) Q
45 ;
46EX ;U IO F Z=1:1 R *X:4 Q:'$T U IO(0) W $C(X) U IO
47EX1 K R,DVBJDX,%Y,%,I,K,Y0,Z2,DVBDXX,DVBLEN,D,DVBIO,X,Z,H,DVBSTN,DVBABORT
48 K DVBLOG,DVBDEV,DVBECHO,DVBEND,DVBTMX,DVBTSK,DVBTX,DVBXM,DVBZ,Y,C,G
49 K DVBID,DVBIDCU,DVBPU,DVBPW,^TMP($J),DVBIP
50 D CLOSE^%ZISTCP
51 Q
52XXX U IO(0) W:$D(X(Z)) !,X(Z) U IO
53 S C=C+1 I C>2 G END
54 H 5 G NAM
55BUSY U IO(0) W !," ",IO," Device is busy" H 1 K DVBLOG,DVBDEV,DVBSTN,DVBDXX,DVBTSK,DVBZ Q
56YYY U IO(0) W !,"Bad Network Password notify Site Manager" D EX Q
57DISP U IO(0) F G=1:1:Z2 I $D(X(G)) D TRIM W:$L(X(G)) !,X(G) I X(G)["0900 BYE" Q
58 U IO Q
59TRIM F H=0:0 Q:$E(X(G))'=$C(10) S X(G)=$E(X(G),2,999)
60 F I=$L(X(G)),-1,1 Q:$E(X(G),I)'=$C(10) S X(G)=$E(X(G),1,I-1)
61 Q
Note: See TracBrowser for help on using the repository browser.