Routine: DVBHQDX

DVBHQDX ;ISC-ALBANY/PKE/PHH-HINQ IDCU,VBA diagnostic ; 3/23/06 7:56am

 ;;4.0;HINQ;**9,12,33,34,49,57**;03/25/92

EN 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

 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

 S DVBDXX=""

 S DVBZ="HINQ"_DVBSTN_" "_"E00000000000000SS12345678NMTEST,HINQ/ABCD1234"

 W !,"This test will take 30 seconds.  No input is required or allowed.",!,"Responses are from the Frame Relay Network, or remote VBA computer."

 W !,"Success in this test will return a message to the user"

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

 I %Y["?" G AGN

 I %'=1 D EX1 Q

 W !!

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

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

 I DVBLOG'?3U1"."4U W !,"IDCU ADDRESS not correct in HINQ Parameter file #395" H 2 G END

 ;I '$L(DVBDEV) W !!,"DEVICE NAME not defined in HINQ DEVICE NAME of DVB #395" H 2 G END

 ;I '$L(DVBID) W !,"HINQ IDCU User ID not defined in IDCU USERNAME-PASSWORD parameter." H 2 G END

 ;I '$L(DVBPW) W !,"HINQ IDCU Password not defined in IDCU USERNAME-PASSWORD parameter." H 2 G END

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

 ;U IO(0) W !,"HINQ device defined as ",DVBDEV,!!

 ;with DVB*4*49 there will be only one server - message will be

 ;"Connecting to VBA"

 U IO(0) W !,"Connecting to VBA"

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

 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 EX

 N DVBPORT,DVBSTN

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

 S DVBPORT=$$PORT^DVBHQDL(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 1 ;;;F Z=0:0 R *X:1 Q:'$T  U IO(0) W $C(X) U IO

 S C=0

NAM ;;;U IO W $C(13)

HEL 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

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

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

 D DISP

END F Z=1:1:30 I $D(X(Z)),X(Z)["???" U IO I DVBLOG'["VHA" W "BYEF",$C(13) Q

 F Z=1:1:30 I $D(X(Z)),X(Z)["$%$" U IO I DVBLOG["VHA" W "DIS",$C(13) Q

EX ;U IO F Z=1:1 R *X:4 Q:'$T  U IO(0) W $C(X) U IO

EX1 K R,DVBJDX,%Y,%,I,K,Y0,Z2,DVBDXX,DVBLEN,D,DVBIO,X,Z,H,DVBSTN,DVBABORT

 K DVBLOG,DVBDEV,DVBECHO,DVBEND,DVBTMX,DVBTSK,DVBTX,DVBXM,DVBZ,Y,C,G

 K DVBID,DVBIDCU,DVBPU,DVBPW,^TMP($J),DVBIP

 D CLOSE^%ZISTCP

XXX U IO(0) W:$D(X(Z)) !,X(Z) U IO

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

 H 5 G NAM

BUSY U IO(0) W !," ",IO,"   Device is busy" H 1 K DVBLOG,DVBDEV,DVBSTN,DVBDXX,DVBTSK,DVBZ Q

YYY U IO(0) W !,"Bad Network Password notify Site Manager" D EX Q

DISP 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

 U IO Q

TRIM F H=0:0 Q:$E(X(G))'=$C(10)  S X(G)=$E(X(G),2,999)

 F I=$L(X(G)),-1,1 Q:$E(X(G),I)'=$C(10)  S X(G)=$E(X(G),1,I-1)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHQDX   3140     printed  Mar 13, 2025@21:03:30                                                                                                                                                                                                     Page 2

DVBHQDX   ;ISC-ALBANY/PKE/PHH-HINQ IDCU,VBA diagnostic ; 3/23/06 7:56am

 +1       ;;4.0;HINQ;**9,12,33,34,49,57**;03/25/92

EN         SET X="A"

           XECUTE ^%ZOSF("LPC")

           KILL X

           SET U="^"

           SET DVBTSK=0

           if '$DATA(DTIME)

               SET DTIME=300

           IF $DATA(IO)<11

               SET IOP="HOME"

               DO ^%ZIS

               KILL IOP

 +1        if '$DATA(DVBSTN)

               SET DVBSTN=$PIECE(^DVB(395,1,0),U,2)

           IF 'DVBSTN

               WRITE !!,"Station number not defined in HINQ Parameters file. "

               DO EX1

               QUIT

 +2        SET DVBDXX=""

 +3        SET DVBZ="HINQ"_DVBSTN_" "_"E00000000000000SS12345678NMTEST,HINQ/ABCD1234"

 +4        WRITE !,"This test will take 30 seconds.  No input is required or allowed.",!,"Responses are from the Frame Relay Network, or remote VBA computer."

 +5        WRITE !,"Success in this test will return a message to the user"

AGN        USE IO(0)

           WRITE !!,"Do you wish to continue"

           SET %=1

           DO YN^DICN

 +1        IF %Y["?"

               GOTO AGN

 +2        IF %'=1

               DO EX1

               QUIT

 +3        WRITE !!

 +4        SET DVBIDCU=^DVB(395,1,"HQVD")_"^"_$PIECE(^("HQ"),"^",11)

 +5        SET DVBLOG=$PIECE(DVBIDCU,U)

           SET (DVBDEV,ION)=$PIECE(DVBIDCU,U,4)

           SET DVBPU=$PIECE(DVBIDCU,U,2)

           SET DVBID=$PIECE(DVBPU,"-")

           SET DVBPW=$PIECE(DVBPU,"-",2)

 +6        IF DVBLOG'?3U1"."4U

               WRITE !,"IDCU ADDRESS not correct in HINQ Parameter file #395"

               HANG 2

               GOTO END

 +7       ;I '$L(DVBDEV) W !!,"DEVICE NAME not defined in HINQ DEVICE NAME of DVB #395" H 2 G END

 +8       ;I '$L(DVBID) W !,"HINQ IDCU User ID not defined in IDCU USERNAME-PASSWORD parameter." H 2 G END

 +9       ;I '$L(DVBPW) W !,"HINQ IDCU Password not defined in IDCU USERNAME-PASSWORD parameter." H 2 G END

 +10       IF $PIECE(DVBIDCU,"^",6)

               SET DVBLOG="VHA"_$PIECE(DVBLOG,"DMS",2)

 +11      ;U IO(0) W !,"HINQ device defined as ",DVBDEV,!!

 +12      ;with DVB*4*49 there will be only one server - message will be

 +13      ;"Connecting to VBA"

 +14       USE IO(0)

           WRITE !,"Connecting to VBA"

 +15      ;

 +16       SET DVBIP=$PIECE($GET(^DVB(395,1,"HQIP")),"^")

 +17       IF DVBIP

               IF DVBIP?1.3N1P1.3N1P1.3N1P1.3N

 +18      IF '$TEST

               if 'DVBTSK

                   WRITE !?3,"RDPC IP Address not defined or invalid in DVB parameter file #395"

               HANG 3

               GOTO EX

 +19      ;

 +20       NEW DVBPORT,DVBSTN

 +21       SET DVBSTN=$PIECE(^DVB(395,1,0),U,2)

 +22       SET DVBPORT=$$PORT^DVBHQDL(DVBSTN)

 +23       DO CALL^%ZISTCP(DVBIP,DVBPORT,"33")

 +24       IF POP

               GOTO BUSY

 +25      ;

 +26      ;;;F Z=0:0 R *X:1 Q:'$T  U IO(0) W $C(X) U IO

           SET X=0

           USE IO

           XECUTE ^%ZOSF("EOFF")

           XECUTE ^%ZOSF("TYPE-AHEAD")

           XECUTE ^%ZOSF("RM")

           HANG 1

 +27       SET C=0

NAM       ;;;U IO W $C(13)

 +1       ;

HEL        FOR Z2=1:1:50

               USE IO

               READ X(Z2):1

               USE IO(0)

               WRITE "."

               USE IO

               HANG 1

               IF X(Z2)["**HELLO**"

                   SET DVBXM=1

                   SET DVBTSK=0

                   SET DVBABORT=0

                   USE IO

                   SET DVBIO=IO

                   SET DVBJDX=1

                   DO MES^DVBHQD1

                   SET IO=DVBIO

                   QUIT

 +1        IF DVBLOG'["VHA"

               USE IO

               WRITE "$$$BYEF",$CHAR(13)

               DO DISP

               GOTO EX

 +2        IF DVBLOG["VHA"

               USE IO

               WRITE "$%$DIS",$CHAR(13),!

               DO DISP

               GOTO EX

 +3        DO DISP

END        FOR Z=1:1:30

               IF $DATA(X(Z))

                   IF X(Z)["???"

                       USE IO

                       IF DVBLOG'["VHA"

                           WRITE "BYEF",$CHAR(13)

                           QUIT

 +1        FOR Z=1:1:30

               IF $DATA(X(Z))

                   IF X(Z)["$%$"

                       USE IO

                       IF DVBLOG["VHA"

                           WRITE "DIS",$CHAR(13)

                           QUIT

 +2       ;

EX        ;U IO F Z=1:1 R *X:4 Q:'$T  U IO(0) W $C(X) U IO

EX1        KILL R,DVBJDX,%Y,%,I,K,Y0,Z2,DVBDXX,DVBLEN,D,DVBIO,X,Z,H,DVBSTN,DVBABORT

 +1        KILL DVBLOG,DVBDEV,DVBECHO,DVBEND,DVBTMX,DVBTSK,DVBTX,DVBXM,DVBZ,Y,C,G

 +2        KILL DVBID,DVBIDCU,DVBPU,DVBPW,^TMP($JOB),DVBIP

 +3        DO CLOSE^%ZISTCP

 +4        QUIT

XXX        USE IO(0)

           if $DATA(X(Z))

               WRITE !,X(Z)

           USE IO

 +1        SET C=C+1

           IF C>2

               GOTO END

 +2        HANG 5

           GOTO NAM

BUSY       USE IO(0)

           WRITE !," ",IO,"   Device is busy"

           HANG 1

           KILL DVBLOG,DVBDEV,DVBSTN,DVBDXX,DVBTSK,DVBZ

           QUIT

YYY        USE IO(0)

           WRITE !,"Bad Network Password notify Site Manager"

           DO EX

           QUIT

DISP       USE IO(0)

           FOR G=1:1:Z2

               IF $DATA(X(G))

                   DO TRIM

                   if $LENGTH(X(G))

                       WRITE !,X(G)

                   IF X(G)["0900 BYE"

                       QUIT

 +1        USE IO

           QUIT

TRIM       FOR H=0:0

               if $EXTRACT(X(G))'=$CHAR(10)

                   QUIT

               SET X(G)=$EXTRACT(X(G),2,999)

 +1        FOR I=$LENGTH(X(G)),-1,1

               if $EXTRACT(X(G),I)'=$CHAR(10)

                   QUIT

               SET X(G)=$EXTRACT(X(G),1,I-1)

 +2        QUIT

DVBHQDX.m