Routine: DVBHQDL

DVBHQDL ;ISC-ALBANY/PKE-HINQ IDCU,RDPC LOGON ; Sep 30, 2021@09:08

 ;;4.0;HINQ;**9,12,32,33,34,38,49,71**;03/25/92;Build 13

 Q  ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition

 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

 I $D(DUZ)#2'=1 W !,"DUZ not defined",! Q

 I $D(^VA(200,DUZ,.1)) S DVBNUM=$P(^(.1),U,9) I DVBNUM

 E  W !,"  HINQ Employee Number not in New Person file",!,"  Notify System manager",! Q

EN Q  ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition

 W !,"This option will take 30 seconds to activate - using IP Addressing"

 U IO(0) W !!,"Do you wish to continue" S %=1 D YN^DICN

 I %'>0 G:%<0 EX1 W !,"    Enter YES to select option" G EN

 I %>1 G EX1

 S DVBTSK=0

 S DVBIOSL=IOSL,DVBIOST=IOST,DVBIOF=IOF

ENTSK Q  ;Patch DVB*4.0*71 prevents VistA HINQ requests due to WEBHINQ transition ;entry from taskman

 D SILENT^DVBHQTM I $D(DVBSTOP) S DVBABORT=1 K DVBSTOP D:'DVBTSK MESS G EX

 S DVBIDCU=^DVB(395,1,"HQVD")_"^"_$P(^("HQ"),"^",11)

 S DVBLOG=$P(DVBIDCU,U),DVBPU=$P(DVBIDCU,U,2),DVBID=$P(DVBPU,"-"),DVBPW=$P(DVBPU,"-",2)

 I DVBLOG'?3U1"."4U W:'DVBTSK !,"IDCU ADDRESS not correct in HINQ Parameter file #395" H 3 S DVBABORT=1 G END

 I $P(DVBIDCU,"^",6) S DVBLOG="VHA"_$P(DVBLOG,"DMS",2)

 I 'DVBTSK U IO(0) W !!,"Connecting to VBA database"

 ;Set up the error trap for cache

 I 'DVBTSK,$$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^DVBHQDL"

 I 'DVBTSK,'$$NEWERR^%ZTER S X="ERR^DVBHQDL",@^%ZOSF("TRAP")

 S DVBIP=$P($G(^DVB(395,1,"HQIP")),"^",1)

 I DVBIP,DVBIP?1.3N1P1.3N1P1.3N1P1.3N

 E  W:'DVBTSK !?3,"RDPC IP Address not defined or invalid in DVB parameter file #395" H 3 G EX1

 S DVBSTN=$P(^DVB(395,1,0),U,2)

 ;with patch DVB*4*49 new routing and interface engines have been

 ;established for the HINQ process.  It was decided that multiple

 ;ports would be added to handle the volume of HINQs.  Three ports

 ;be used exclusively for the HEC, six for the VAMCs.  A new field

 ;(#23 - AAC PORT DESIGNATOR) has been added to act as a counter for

 ;the HINQ connections that have been requested. #3 or #6 + this field

 ;yeilds a code that is then interpreted into a port number depending

 ;on the station number.

 S DVBPORT=$$PORT(DVBSTN)

 D CALL^%ZISTCP(DVBIP,DVBPORT,"33")

 I POP G BUSY

 S X=0

 U IO X ^%ZOSF("EOFF"),^%ZOSF("TYPE-AHEAD"),^%ZOSF("RM") H 3

 S C=0 ;leave this off of next line

NAM ;

HEL ;

 N DVBFLG,DVBHEL,DVBQUIT

 I DVBTSK D

 . K X U IO F Z=1:1:50 R X(Z):3 D  Q:$G(DVBQUIT)=1

 . . I X(Z)["**HELLO**" K X S DVBABORT=0,DVBQUIT=1 Q

 . . I '$L(X(Z)) Q

 . . I $G(DVBFLG)>0 D HELLO2(Z)

 . . I $G(DVBHEL)["**HELLO**" K X S DVBABORT=0,DVBQUIT=1 Q

 . . S DVBFLG=0

 . . I X(Z)["**H" D HELLO(Z)

 . . I $E(X(Z),$L(X(Z)))="*" D HELLO(Z)

 . I Z'<50 S DVBVBA="NO"

 I 'DVBTSK D

 . U IO(0) W !!,"One moment, please...",!! U IO

 . K X F Z2=1:1:50 U IO R X(Z2):3 U IO(0) W "." D  Q:$G(DVBQUIT)=1

 . . I X(Z2)["**HELLO**" D CONT S DVBQUIT=1 Q

 . . I '$L(X(Z2)) Q

 . . I $G(DVBFLG)>0 D HELLO2(Z2)

 . . I $G(DVBHEL)["**HELLO**" D CONT S DVBQUIT=1 Q

 . . S DVBFLG=0

 . . I X(Z2)["**H" D HELLO(Z2)

 . . I $E(X(Z2),$L(X(Z2)))="*" D HELLO(Z2)

 . I Z2'<50 U IO(0) W !,"HINQ not allowed at this time" D MESS U IO

END ;

 I DVBTSK Q

 I DVBLOG["VHA" U IO W "$%$DIS",$C(13),!

 I DVBLOG'["VHA" U IO W "$$$BYEF",$C(13)

 U IO(0) W !!,"Terminating VBA session...",! U IO

 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

 ;I '$D(DVBIO) Q

EX I DVBTSK S DVBABORT=1 Q

EX1 K %,DVBNUM,DVBTSK,DVBLOG,DVBDEV,DVBVDI,DVBABORT,X,Y,Z,C,G,DVBIP,DVBIOSL,DVBIOST,DVBIOF

 D CLOSE^%ZISTCP Q

XXX I 'DVBTSK U IO(0) W !,X U IO

RESET S C=C+1 I C>2 G END

 H 5 G NAM

BUSY I 'DVBTSK W !," ",IO,"   Device is busy" D SUS H 1 G EX

YYY I 'DVBTSK U IO(0) W !,"Bad Network User ID/Password notify Site Manager " H 1 G EX

SUS I 'DVBTSK U IO(0) W !,"Enter requests in the Suspense file" Q

ERR ;Come here on error, screen with error screens

 S DVBHERR=$$EC^%ZOSV

 I DVBHERR["READ"!(DVBHERR["ENDOFFIL") DO

 . U IO(0) W !,"Disconnect trapped..."

 D ^%ZTER

 D CLOSE^%ZISTCP

 G UNWIND^%ZTER

MESS ;DVB*38 HINQ UNAVAILABLE MESSAGE  MLR 5.10.01

 I $G(DVBTSK)>0 Q

 U IO(0)

 W !!

 W $$CJ^XLFSTR("ATTENTION:  HINQ IS CURRENTLY UNAVAILABLE!",80,".")

 W !!,$$CJ^XLFSTR("Please enter HINQ request in Suspense File",80)

 W !,$$CJ^XLFSTR("or try again later.",80)

 W !!

 Q  ;MESS

CONT ;display messages and continue with HINQ

 U IO(0) W !!,"You may continue with your HINQ request...",!!

 U IO S DVBIO=IO D ^DVBHQD1 U IO(0) W ! S IO=DVBIO

HELLO(IND) ;if **HELLO** string was broken up, save it to a var to combine

 ;with next read

 ;input parameter indicates whether called from task or direct

 S DVBFLG=1

 I X(IND)["**H" S DVBHEL="**H"_$P(X(IND),"**H",2) Q

 I $E(X(IND),$L(X(IND))-1)="*" S DVBHEL="**" Q

 S DVBHEL="*"

HELLO2(IND) ;add string from next read to string in HELLO

 I $G(DVBHEL)["" S DVBHEL=DVBHEL_$E(X(IND),1,9-$L(DVBHEL))

PORT(DVBSTN) ;

 K DVBERR

 S DVBPORT=50010

 S DVBPT=$$GET1^DIQ(395,"1,",23,,,"DVBERR")

 I $D(DVBERR) D  Q DVBPORT

 . S DVBFDA(395,"1,",23)=0

 . D FILE^DIE(,"DVBFDA","DVBERR")

 S DVBFDA(395,"1,",23)=DVBPT+1

 D FILE^DIE("E","DVBFDA","DVBERR")

 I $G(DVBSTN)=742 D

 . ;station 742 is the HEC - these 3 ports are reserved for the HEC

 . S DVBPORT=$G(DVBPT)#3 ;50000 - 50002

 . S DVBPORT=50000+DVBPORT

 I $G(DVBSTN)'=742 D

 . ;these 6 ports are for the use of VAMCs

 . S DVBPORT=$G(DVBPT)#6

 . S DVBPORT=50010+DVBPORT ;50010 - 50015

 Q DVBPORT

DVBHQDL.m