source: FOIAVistA/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHQDL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1DVBHQDL ;ISC-ALBANY/PKE-HINQ IDCU,RDPC LOGON ; 10/27/05 4:12pm
2 ;;4.0;HINQ;**9,12,32,33,34,38,49**;03/25/92
3 S X="A" X ^%ZOSF("LPC") K X S U="^" I $D(IO)<11 S IOP="HOME" D ^%ZIS K IOP S:'$D(DTIME) DTIME=300
4 I $D(DUZ)#2'=1 W !,"DUZ not defined",! Q
5 I $D(^VA(200,DUZ,.1)) S DVBNUM=$P(^(.1),U,9) I DVBNUM
6 E W !," HINQ Employee Number not in New Person file",!," Notify System manager",! Q
7 ;
8EN W !,"This option will take 30 seconds to activate - using IP Addressing"
9 U IO(0) W !!,"Do you wish to continue" S %=1 D YN^DICN
10 I %'>0 G:%<0 EX1 W !," Enter YES to select option" G EN
11 I %>1 G EX1
12 S DVBTSK=0
13 S DVBIOSL=IOSL,DVBIOST=IOST,DVBIOF=IOF
14ENTSK ;entry from taskman
15 D SILENT^DVBHQTM I $D(DVBSTOP) S DVBABORT=1 K DVBSTOP D:'DVBTSK MESS G EX
16 S DVBIDCU=^DVB(395,1,"HQVD")_"^"_$P(^("HQ"),"^",11)
17 S DVBLOG=$P(DVBIDCU,U),DVBPU=$P(DVBIDCU,U,2),DVBID=$P(DVBPU,"-"),DVBPW=$P(DVBPU,"-",2)
18 I DVBLOG'?3U1"."4U W:'DVBTSK !,"IDCU ADDRESS not correct in HINQ Parameter file #395" H 3 S DVBABORT=1 G END
19 I $P(DVBIDCU,"^",6) S DVBLOG="VHA"_$P(DVBLOG,"DMS",2)
20 I 'DVBTSK U IO(0) W !!,"Connecting to VBA database"
21 ;
22 ;Set up the error trap for cache
23 I 'DVBTSK,$$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^DVBHQDL"
24 I 'DVBTSK,'$$NEWERR^%ZTER S X="ERR^DVBHQDL",@^%ZOSF("TRAP")
25 ;
26 S DVBIP=$P($G(^DVB(395,1,"HQIP")),"^",1)
27 I DVBIP,DVBIP?1.3N1P1.3N1P1.3N1P1.3N
28 E W:'DVBTSK !?3,"RDPC IP Address not defined or invalid in DVB parameter file #395" H 3 G EX1
29 ;
30 S DVBSTN=$P(^DVB(395,1,0),U,2)
31 ;
32 ;with patch DVB*4*49 new routing and interface engines have been
33 ;established for the HINQ process. It was decided that multiple
34 ;ports would be added to handle the volume of HINQs. Three ports
35 ;be used exclusively for the HEC, six for the VAMCs. A new field
36 ;(#23 - AAC PORT DESIGNATOR) has been added to act as a counter for
37 ;the HINQ connections that have been requested. #3 or #6 + this field
38 ;yeilds a code that is then interpreted into a port number depending
39 ;on the station number.
40 S DVBPORT=$$PORT(DVBSTN)
41 ;
42 D CALL^%ZISTCP(DVBIP,DVBPORT,"33")
43 I POP G BUSY
44 S X=0
45 U IO X ^%ZOSF("EOFF"),^%ZOSF("TYPE-AHEAD"),^%ZOSF("RM") H 3
46 S C=0 ;leave this off of next line
47NAM ;
48HEL ;
49 N DVBFLG,DVBHEL,DVBQUIT
50 I DVBTSK D
51 . K X U IO F Z=1:1:50 R X(Z):3 D Q:$G(DVBQUIT)=1
52 . . I X(Z)["**HELLO**" K X S DVBABORT=0,DVBQUIT=1 Q
53 . . I '$L(X(Z)) Q
54 . . I $G(DVBFLG)>0 D HELLO2(Z)
55 . . I $G(DVBHEL)["**HELLO**" K X S DVBABORT=0,DVBQUIT=1 Q
56 . . S DVBFLG=0
57 . . I X(Z)["**H" D HELLO(Z)
58 . . I $E(X(Z),$L(X(Z)))="*" D HELLO(Z)
59 . I Z'<50 S DVBVBA="NO"
60 I 'DVBTSK D
61 . U IO(0) W !!,"One moment, please...",!! U IO
62 . K X F Z2=1:1:50 U IO R X(Z2):3 U IO(0) W "." D Q:$G(DVBQUIT)=1
63 . . I X(Z2)["**HELLO**" D CONT S DVBQUIT=1 Q
64 . . I '$L(X(Z2)) Q
65 . . I $G(DVBFLG)>0 D HELLO2(Z2)
66 . . I $G(DVBHEL)["**HELLO**" D CONT S DVBQUIT=1 Q
67 . . S DVBFLG=0
68 . . I X(Z2)["**H" D HELLO(Z2)
69 . . I $E(X(Z2),$L(X(Z2)))="*" D HELLO(Z2)
70 . I Z2'<50 U IO(0) W !,"HINQ not allowed at this time" D MESS U IO
71END ;
72 I DVBTSK Q
73 I DVBLOG["VHA" U IO W "$%$DIS",$C(13),!
74 I DVBLOG'["VHA" U IO W "$$$BYEF",$C(13)
75 U IO(0) W !!,"Terminating VBA session...",! U IO
76 U IO F Z=1:1:6 R X(Z):1 Q:'$T I X(Z)["0900 BYE" U IO(0) W !,"VBA DISCONNECTED",! Q ;U IO Q
77 ;I '$D(DVBIO) Q
78 ;
79EX I DVBTSK S DVBABORT=1 Q
80EX1 K %,DVBNUM,DVBTSK,DVBLOG,DVBDEV,DVBVDI,DVBABORT,X,Y,Z,C,G,DVBIP,DVBIOSL,DVBIOST,DVBIOF
81 D CLOSE^%ZISTCP Q
82 Q
83XXX I 'DVBTSK U IO(0) W !,X U IO
84RESET S C=C+1 I C>2 G END
85 H 5 G NAM
86 ;
87BUSY I 'DVBTSK W !," ",IO," Device is busy" D SUS H 1 G EX
88YYY I 'DVBTSK U IO(0) W !,"Bad Network User ID/Password notify Site Manager " H 1 G EX
89 Q
90SUS I 'DVBTSK U IO(0) W !,"Enter requests in the Suspense file" Q
91 Q
92ERR ;Come here on error, screen with error screens
93 S DVBHERR=$$EC^%ZOSV
94 I DVBHERR["READ"!(DVBHERR["ENDOFFIL") DO
95 . U IO(0) W !,"Disconnect trapped..."
96 D ^%ZTER
97 D CLOSE^%ZISTCP
98 G UNWIND^%ZTER
99 Q
100MESS ;DVB*38 HINQ UNAVAILABLE MESSAGE MLR 5.10.01
101 I $G(DVBTSK)>0 Q
102 U IO(0)
103 W !!
104 W $$CJ^XLFSTR("ATTENTION: HINQ IS CURRENTLY UNAVAILABLE!",80,".")
105 W !!,$$CJ^XLFSTR("Please enter HINQ request in Suspense File",80)
106 W !,$$CJ^XLFSTR("or try again later.",80)
107 W !!
108 Q ;MESS
109 ;
110CONT ;display messages and continue with HINQ
111 U IO(0) W !!,"You may continue with your HINQ request...",!!
112 U IO S DVBIO=IO D ^DVBHQD1 U IO(0) W ! S IO=DVBIO
113 Q
114 ;
115HELLO(IND) ;if **HELLO** string was broken up, save it to a var to combine
116 ;with next read
117 ;input parameter indicates whether called from task or direct
118 S DVBFLG=1
119 I X(IND)["**H" S DVBHEL="**H"_$P(X(IND),"**H",2) Q
120 I $E(X(IND),$L(X(IND))-1)="*" S DVBHEL="**" Q
121 S DVBHEL="*"
122 Q
123HELLO2(IND) ;add string from next read to string in HELLO
124 I $G(DVBHEL)["" S DVBHEL=DVBHEL_$E(X(IND),1,9-$L(DVBHEL))
125 Q
126 ;
127PORT(DVBSTN) ;
128 K DVBERR
129 S DVBPORT=50010
130 S DVBPT=$$GET1^DIQ(395,"1,",23,,,"DVBERR")
131 I $D(DVBERR) D Q DVBPORT
132 . S DVBFDA(395,"1,",23)=0
133 . D FILE^DIE(,"DVBFDA","DVBERR")
134 S DVBFDA(395,"1,",23)=DVBPT+1
135 D FILE^DIE("E","DVBFDA","DVBERR")
136 I $G(DVBSTN)=742 D
137 . ;station 742 is the HEC - these 3 ports are reserved for the HEC
138 . S DVBPORT=$G(DVBPT)#3 ;50000 - 50002
139 . S DVBPORT=50000+DVBPORT
140 I $G(DVBSTN)'=742 D
141 . ;these 6 ports are for the use of VAMCs
142 . S DVBPORT=$G(DVBPT)#6
143 . S DVBPORT=50010+DVBPORT ;50010 - 50015
144 Q DVBPORT
Note: See TracBrowser for help on using the repository browser.