ABSPOSAB ; IHS/FCS/DRS - various modem commands ; [ 06/28/2002 5:28 AM ]
;;1.0;PHARMACY POINT OF SALE;**2**;JUN 21, 2001;Build 27
Q
; Low-level IO routines which:
; * take DIALOUT as an argument
; * optionally ECHO as a second argument, passed along to LOG^POSU
; * can be called as either DO ^ or as a $$ function
; * preserve your current $IO
;
; T1 line should reach these for OPEN and FLUSH, only.
;
;
;IHS/SD/lwj 06/10/02 Changes made to make the open and
; use commands Cache compliant. Open command for Cache must
; be in the format of:
; O "|TCP|6802":(999.999.999.9:6802:"M"):3
; (the "M" is very important in extending the buffer for the
; large claims.)
; Changes tested on the Parker Cache test data base and will
; be incorporated in Patch 2 of POS V1.0. Changes made
; to the ABSP Dial Out file (^ABSP(9002313.55) to include a
; Cache Device - this device will be used for the T1 connection
; (New field is 420.03 on the DEVICE node)
;
;
OPEN(DIALOUT) ;EP - return 0 if okay, nonzero if error
; Error can be: 79 - $ZB=79, reproducible by telnet <server> <port>
; or perhaps just due to a few seconds while port resets from prev
; use.
N IO,SERVER,PORT,BAUD,RETVAL ;,MSYSTEM
;S MSYSTEM=$$MSYSTEM
S IO=$$IO^ABSPOSA(DIALOUT) ; Mumps IO device number
N X S X=$T(+0)_" - MODEM - OPEN - device "_IO
I $$TCP^ABSPOSA(DIALOUT) D ; server type device; get server & port names
. S SERVER=$$SERVER^ABSPOSA(DIALOUT),PORT=$$PORT^ABSPOSA(DIALOUT)
. S X=X_" - "_SERVER_", port "_PORT
E D
. S BAUD=$$GET55FLD^ABSPOSA(DIALOUT,208)
. S:'BAUD BAUD=2400
D LOG^ABSPOSL(X,$G(ECHO))
I $$TCP^ABSPOSA(DIALOUT) D
. ; IHS/SD/lwj 06/10/02 begin changes for Cache
. I ^%ZOSF("OS")["OpenM" D Q ;Cache system
.. S RETVAL=0
.. O IO:(SERVER:PORT:"M"):3 ;O "|TCP|6802":("999.999.999.9":6802:"M"):3
.. I '$T S RETVAL=1,X=$T(+0)_" - |TCP|:("_SERVER_":"_PORT_")" ;failed
.. I 'RETVAL U IO
.. Q
. I ^%ZOSF("OS")'["OpenM" D Q
.. O IO:(:3) U IO::"TCP" W /SOCKET(SERVER,PORT)
.. S RETVAL=$ZB
.. I $ZB'=0 D
... S X=$T(+0)_" - MODEM - W /SOCKET("_SERVER_","_PORT_") - $ZB="_$ZB
.. Q
.. ; IHS/SD/lwj 06/10/02 end changes for Cache
E D ; a plain old traditional modem
. N PARAM S PARAM(1)=0 ; no echo
. S PARAM(5)=8388608 ; don't interpret control characters
. S PARAM(5)=PARAM(5)+2097152 ; CTRL/O is data, not usual CTRL/O
. S PARAM(5)=PARAM(5)+4096 ; TAB not expanded
. S PARAM(5)=PARAM(5)+1 ;no echo
. S PARAM(8)=9*4096
. S PARAM(8)=PARAM(8)+(0*256)
. S PARAM(8)=PARAM(8)+(5*16)
. S PARAM(8)=PARAM(8)+$S(BAUD=2400:11,BAUD=1200:9)
. O IO:(PARAM(1)::::PARAM(5):::PARAM(8)):600
. I '$T D
. . S X=$T(+0)_" - MODEM - OPEN command timed out - could not get device "_IO
. . S RETVAL=-1
. E S RETVAL=0
I RETVAL D LOG^ABSPOSL(X,$G(ECHO))
Q:$Q RETVAL Q
CLOSE(DIALOUT) ;EP - return 0 if okay, nonzero if error
D FLUSH(DIALOUT,2) ; give it 2 secs to flush?
N IO S IO=$$IO^ABSPOSA(DIALOUT)
D LOG^ABSPOSL($T(+0)_" - MODEM - CLOSE - device "_IO,$G(ECHO))
C IO Q:$Q 0 Q
FLUSH(DIALOUT,TO) ;EP - return 0 if okay, nonzero if error
I '$D(TO) S TO=0
N IO S IO=$$IO^ABSPOSA(DIALOUT)
N X,I,FLUSHSTR,MAXI S FLUSHSTR="",MAXI=3000
S X="FZE^"_$T(+0),@^%ZOSF("TRAP")
U IO F I=0:1:MAXI+1 R *X:TO Q:'$T D
.I I'>60 S FLUSHSTR=FLUSHSTR_$C(X)
.E I I=60 S $E(FLUSHSTR,58,60)="..."
; I = how many characters were flushed
I I D
. N N F N=I:-1:1 I $E(FLUSHSTR,N)?1C D
. . S FLUSHSTR=$E(FLUSHSTR,1,N-1)_"\"_$TR($J($A(FLUSHSTR,N),3)," ","0")_$E(FLUSHSTR,N+1,$L(FLUSHSTR))
. D LOG^ABSPOSL($T(+0)_" - MODEM - FLUSH - "_I_" byte(s) - "_FLUSHSTR,$G(ECHO))
I I>MAXI D Q -1 ; runaway - error
. D LOG^ABSPOSL($T(+0)_" - MODEM - FLUSH - runaway after "_MAXI_" bytes",$G(ECHO))
Q:$Q 0 Q
; Error trap for FLUSH, still need this for <DSCON>
FZE D LOGZE("FLUSH") Q:$Q -1 Q
LOGZE(WHERE) D LOG^ABSPOSL($T(+0)_" - MODEM - "_WHERE_" - $ZE="_$$ZE^ABSPOS) Q
;
; ECHOOFF Issue the echo off command to the modem.
; It is assumed that every modem type has the command E0.
; If that changes, you need to build a field into 9002313.54.
;
ECHOOFF(DIALOUT) ;
N RETVAL
D LOG^ABSPOSL($T(+0)_" - MODEM - E0 to turn echo off",$G(ECHO))
D COMMAND^ABSPOSA(DIALOUT,"E0") ; hopefully same for all modem types?
S RETVAL=$$WAITSTR^ABSPOSAW(DIALOUT,"OK",10) D FLUSH(DIALOUT,1)
Q:$Q RETVAL Q
;
; ATZ Issue the ATZ (Reset) command to the modem.
; It is assumed that every modem type has the command Z.
; If that changes, you need to build a field into 9002313.54.
;
ATZ(DIALOUT) ;EP - return 0 if okay, nonzero if error
; added FLUSH calls to give a little cushion around the ATZ command
N RETVAL
D ECHOOFF(DIALOUT)
D LOG^ABSPOSL($T(+0)_" - MODEM - INIT - ATZ command",$G(ECHO))
D COMMAND^ABSPOSA(DIALOUT,"ATZ") ; hopefully same for all modem types?
S RETVAL=$$WAITSTR^ABSPOSAW(DIALOUT,"OK",20) D FLUSH(DIALOUT,1)
D ECHOOFF(DIALOUT) ; in case software reset turned it on again
Q:$Q RETVAL Q
;
; INIMODEM Send the modem initialization command.
; This varies a lot by modem type.
;
INIMODEM(DIALOUT) ;EP - return 0 if okay, nonzero if error
N RETVAL
N INI S INI=$P(^ABSP(9002313.54,$$MODEMTYP^ABSPOSA(DIALOUT),"INIT"),U)
; ANMC: "AT&FE0&Q1V1X1&E0&E3&E10&E12&E14$MB2400$SB2400#A3"
D COMMAND^ABSPOSA(DIALOUT,INI)
D LOG^ABSPOSL($T(+0)_" - MODEM - INIT - command "_INI,$G(ECHO))
S RETVAL=$$WAITSTR^ABSPOSAW(DIALOUT,"OK",20) D FLUSH(DIALOUT,1)
Q:$Q RETVAL Q
;
; MODEMSTS - Issue the modem's query command and log the output.
; The command comes from 9002313.54, since the query
; command varies a lot from one modem to another.
;
MODEMSTS(DIALOUT) ;EP - return 0; or you can just DO it.
N IO,RETVAL,CMD,TIMEOUT,LOOK4OK,I,X,% S IO=$$IO^ABSPOSA(DIALOUT)
N MODEMTYP S MODEMTYP=$$MODEMTYP^ABSPOSA(DIALOUT)
S %=$G(^ABSP(9002313.54,MODEMTYP,"QUERY FOR STATUS"))
S CMD=$P(%,U),TIMEOUT=$P(%,U,2),LOOK4OK=$P(%,U,3)
I CMD="" Q:$Q 0 Q ; no Inquiry command for this modem type??
I 'TIMEOUT S TIMEOUT=1
D LOG^ABSPOSL($T(+0)_" - MODEM - QUERY - command "_CMD,$G(ECHO))
D COMMAND^ABSPOSA(DIALOUT,CMD)
U IO
F I=1:1 R X(I):TIMEOUT Q:'$T Q:LOOK4OK&($TR(X(I),$C(13,10),"")="OK")
D LOG^ABSPOSL($T(+0)_" - MODEM - QUERY - reply:",$G(ECHO))
F I=1:1 Q:'$D(X(I)) D
.D LOG^ABSPOSL($TR(X(I),$C(13,10),""),$G(ECHO))
Q:$Q 0 Q
;
; DIAL - Issue the command to dial the phone
; and wait for the successful CONNECT 2400 response.
;
DIAL(DIALOUT) ;EP - return 0 if okay, nonzero if error
N IO,RETVAL,DIAL S IO=$$IO^ABSPOSA(DIALOUT)
N DIAL,MODEMTYP,CONNMSG
S DIAL="ATDT"_$$PHONENUM(DIALOUT)
S MODEMTYP=$$MODEMTYP^ABSPOSA(DIALOUT)
S CONNMSG=$P($G(^ABSP(9002313.54,MODEMTYP,"CONNECT MESSAGE")),U)
D LOG^ABSPOSL($T(+0)_" - MODEM - DIAL - command "_DIAL,$G(ECHO))
D COMMAND^ABSPOSA(DIALOUT,DIAL)
N X S X=$T(+0)_" - MODEM - DIAL - "
I CONNMSG="" D S RETVAL=0
.D LOG^ABSPOSL(X_" but no CONNECT MESSAGE in 9002313.54",$G(ECHO))
E I '$$WAITSTR^ABSPOSAW(DIALOUT,CONNMSG,40) D S RETVAL=0
.D LOG^ABSPOSL(X_"successful",$G(ECHO))
E D S RETVAL=1
.D LOG^ABSPOSL(X_"did not receive expected "_CONNMSG,$G(ECHO))
Q:$Q RETVAL Q 0
;
; $$PHONENUM Look up the phone number for this dial out.
;
PHONENUM(N) ;
N X,Y
S X=$P($G(^ABSP(9002313.99,1,"OUTSIDE LINE")),U)
; If you do need to dial a number to get an outside line,
; tack on a comma if needed - modem will pause to wait for
; second dial tone. (No parameter needed yet since apparently
; all modems have this feature.)
I X]"",$E(X,$L(X))'="," S X=X_","
S Y=$$GET55FLD^ABSPOSA(N,450.01)
S X=$P(X,U,$S($E(Y)=1:1,1:2)) ; local or long distance?
Q $S(Y]"":X_Y,1:"")
;
; HANGUP - Issue the hang up command.
;
HANGUP(DIALOUT) ;EP - this does nothing.
; The "W +" and timeout stuff wasn't effective.
; Just the CLOSE seems to take care of things okay at ANMC.
; This is probably the case at other sites, too.
N IO S IO=$$IO^ABSPOSA(DIALOUT)
G HANGUP99
N TRY,I,ANS
;
;Make sure input variables are defined
Q:$G(IO)=""
;
;Get modem into command mode, then hangup, try up to 3 times
F TRY=1:1:3 D Q:ANS=1
.;O IO
.H 1
.F I=1:1:3 U IO W "+"
.H 2
.U IO W "ATH0",!
.H 1
. D IMPOSS^ABSPOSUE("P","T","Code not reachable","Obsolete subroutine/not used","HANGUP",$T(+0))
.;need to ; S ANS=$$WaitFor(IO,"OK",2)
;
;Close input/output device
HANGUP99 ;D CLOSE^ABSPOSAB(DIALOUT)
Q
ABSPOSAB ; IHS/FCS/DRS - various modem commands ; [ 06/28/2002 5:28 AM ]
+1 ;;1.0;PHARMACY POINT OF SALE;**2**;JUN 21, 2001;Build 27
+2 QUIT
+3 ; Low-level IO routines which:
+4 ; * take DIALOUT as an argument
+5 ; * optionally ECHO as a second argument, passed along to LOG^POSU
+6 ; * can be called as either DO ^ or as a $$ function
+7 ; * preserve your current $IO
+8 ;
+9 ; T1 line should reach these for OPEN and FLUSH, only.
+10 ;
+11 ;
+12 ;IHS/SD/lwj 06/10/02 Changes made to make the open and
+13 ; use commands Cache compliant. Open command for Cache must
+14 ; be in the format of:
+15 ; O "|TCP|6802":(999.999.999.9:6802:"M"):3
+16 ; (the "M" is very important in extending the buffer for the
+17 ; large claims.)
+18 ; Changes tested on the Parker Cache test data base and will
+19 ; be incorporated in Patch 2 of POS V1.0. Changes made
+20 ; to the ABSP Dial Out file (^ABSP(9002313.55) to include a
+21 ; Cache Device - this device will be used for the T1 connection
+22 ; (New field is 420.03 on the DEVICE node)
+23 ;
+24 ;
OPEN(DIALOUT) ;EP - return 0 if okay, nonzero if error
+1 ; Error can be: 79 - $ZB=79, reproducible by telnet <server> <port>
+2 ; or perhaps just due to a few seconds while port resets from prev
+3 ; use.
+4 ;,MSYSTEM
NEW IO,SERVER,PORT,BAUD,RETVAL
+5 ;S MSYSTEM=$$MSYSTEM
+6 ; Mumps IO device number
SET IO=$$IO^ABSPOSA(DIALOUT)
+7 NEW X
SET X=$TEXT(+0)_" - MODEM - OPEN - device "_IO
+8 ; server type device; get server & port names
IF $$TCP^ABSPOSA(DIALOUT)
Begin DoDot:1
+9 SET SERVER=$$SERVER^ABSPOSA(DIALOUT)
SET PORT=$$PORT^ABSPOSA(DIALOUT)
+10 SET X=X_" - "_SERVER_", port "_PORT
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET BAUD=$$GET55FLD^ABSPOSA(DIALOUT,208)
+13 IF 'BAUD
SET BAUD=2400
End DoDot:1
+14 DO LOG^ABSPOSL(X,$GET(ECHO))
+15 IF $$TCP^ABSPOSA(DIALOUT)
Begin DoDot:1
+16 ; IHS/SD/lwj 06/10/02 begin changes for Cache
+17 ;Cache system
IF ^%ZOSF("OS")["OpenM"
Begin DoDot:2
+18 SET RETVAL=0
+19 ;O "|TCP|6802":("999.999.999.9":6802:"M"):3
OPEN IO:(SERVER:PORT:"M"):3
+20 ;failed
IF '$TEST
SET RETVAL=1
SET X=$TEXT(+0)_" - |TCP|:("_SERVER_":"_PORT_")"
+21 IF 'RETVAL
USE IO
+22 QUIT
End DoDot:2
QUIT
+23 IF ^%ZOSF("OS")'["OpenM"
Begin DoDot:2
+24 OPEN IO:(:3)
USE IO::"TCP"
WRITE /SOCKET(SERVER,PORT)
+25 SET RETVAL=$ZB
+26 IF $ZB'=0
Begin DoDot:3
+27 SET X=$TEXT(+0)_" - MODEM - W /SOCKET("_SERVER_","_PORT_") - $ZB="_$ZB
End DoDot:3
+28 QUIT
+29 ; IHS/SD/lwj 06/10/02 end changes for Cache
End DoDot:2
QUIT
End DoDot:1
+30 ; a plain old traditional modem
IF '$TEST
Begin DoDot:1
+31 ; no echo
NEW PARAM
SET PARAM(1)=0
+32 ; don't interpret control characters
SET PARAM(5)=8388608
+33 ; CTRL/O is data, not usual CTRL/O
SET PARAM(5)=PARAM(5)+2097152
+34 ; TAB not expanded
SET PARAM(5)=PARAM(5)+4096
+35 ;no echo
SET PARAM(5)=PARAM(5)+1
+36 SET PARAM(8)=9*4096
+37 SET PARAM(8)=PARAM(8)+(0*256)
+38 SET PARAM(8)=PARAM(8)+(5*16)
+39 SET PARAM(8)=PARAM(8)+$SELECT(BAUD=2400:11,BAUD=1200:9)
+40 OPEN IO:(PARAM(1)::::PARAM(5):::PARAM(8)):600
+41 IF '$TEST
Begin DoDot:2
+42 SET X=$TEXT(+0)_" - MODEM - OPEN command timed out - could not get device "_IO
+43 SET RETVAL=-1
End DoDot:2
+44 IF '$TEST
SET RETVAL=0
End DoDot:1
+45 IF RETVAL
DO LOG^ABSPOSL(X,$GET(ECHO))
+46 IF $QUIT
QUIT RETVAL
QUIT
CLOSE(DIALOUT) ;EP - return 0 if okay, nonzero if error
+1 ; give it 2 secs to flush?
DO FLUSH(DIALOUT,2)
+2 NEW IO
SET IO=$$IO^ABSPOSA(DIALOUT)
+3 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - CLOSE - device "_IO,$GET(ECHO))
+4 CLOSE IO
IF $QUIT
QUIT 0
QUIT
FLUSH(DIALOUT,TO) ;EP - return 0 if okay, nonzero if error
+1 IF '$DATA(TO)
SET TO=0
+2 NEW IO
SET IO=$$IO^ABSPOSA(DIALOUT)
+3 NEW X,I,FLUSHSTR,MAXI
SET FLUSHSTR=""
SET MAXI=3000
+4 SET X="FZE^"_$TEXT(+0)
SET @^%ZOSF("TRAP")
+5 USE IO
FOR I=0:1:MAXI+1
READ *X:TO
IF '$TEST
QUIT
Begin DoDot:1
+6 IF I'>60
SET FLUSHSTR=FLUSHSTR_$CHAR(X)
+7 IF '$TEST
IF I=60
SET $EXTRACT(FLUSHSTR,58,60)="..."
End DoDot:1
+8 ; I = how many characters were flushed
+9 IF I
Begin DoDot:1
+10 NEW N
FOR N=I:-1:1
IF $EXTRACT(FLUSHSTR,N)?1C
Begin DoDot:2
+11 SET FLUSHSTR=$EXTRACT(FLUSHSTR,1,N-1)_"\"_$TRANSLATE($JUSTIFY($ASCII(FLUSHSTR,N),3)," ","0")_$EXTRACT(FLUSHSTR,N+1,$LENGTH(FLUSHSTR))
End DoDot:2
+12 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - FLUSH - "_I_" byte(s) - "_FLUSHSTR,$GET(ECHO))
End DoDot:1
+13 ; runaway - error
IF I>MAXI
Begin DoDot:1
+14 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - FLUSH - runaway after "_MAXI_" bytes",$GET(ECHO))
End DoDot:1
QUIT -1
+15 IF $QUIT
QUIT 0
QUIT
+16 ; Error trap for FLUSH, still need this for <DSCON>
FZE DO LOGZE("FLUSH")
IF $QUIT
QUIT -1
QUIT
LOGZE(WHERE) DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - "_WHERE_" - $ZE="_$$ZE^ABSPOS)
QUIT
+1 ;
+2 ; ECHOOFF Issue the echo off command to the modem.
+3 ; It is assumed that every modem type has the command E0.
+4 ; If that changes, you need to build a field into 9002313.54.
+5 ;
ECHOOFF(DIALOUT) ;
+1 NEW RETVAL
+2 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - E0 to turn echo off",$GET(ECHO))
+3 ; hopefully same for all modem types?
DO COMMAND^ABSPOSA(DIALOUT,"E0")
+4 SET RETVAL=$$WAITSTR^ABSPOSAW(DIALOUT,"OK",10)
DO FLUSH(DIALOUT,1)
+5 IF $QUIT
QUIT RETVAL
QUIT
+6 ;
+7 ; ATZ Issue the ATZ (Reset) command to the modem.
+8 ; It is assumed that every modem type has the command Z.
+9 ; If that changes, you need to build a field into 9002313.54.
+10 ;
ATZ(DIALOUT) ;EP - return 0 if okay, nonzero if error
+1 ; added FLUSH calls to give a little cushion around the ATZ command
+2 NEW RETVAL
+3 DO ECHOOFF(DIALOUT)
+4 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - INIT - ATZ command",$GET(ECHO))
+5 ; hopefully same for all modem types?
DO COMMAND^ABSPOSA(DIALOUT,"ATZ")
+6 SET RETVAL=$$WAITSTR^ABSPOSAW(DIALOUT,"OK",20)
DO FLUSH(DIALOUT,1)
+7 ; in case software reset turned it on again
DO ECHOOFF(DIALOUT)
+8 IF $QUIT
QUIT RETVAL
QUIT
+9 ;
+10 ; INIMODEM Send the modem initialization command.
+11 ; This varies a lot by modem type.
+12 ;
INIMODEM(DIALOUT) ;EP - return 0 if okay, nonzero if error
+1 NEW RETVAL
+2 NEW INI
SET INI=$PIECE(^ABSP(9002313.54,$$MODEMTYP^ABSPOSA(DIALOUT),"INIT"),U)
+3 ; ANMC: "AT&FE0&Q1V1X1&E0&E3&E10&E12&E14$MB2400$SB2400#A3"
+4 DO COMMAND^ABSPOSA(DIALOUT,INI)
+5 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - INIT - command "_INI,$GET(ECHO))
+6 SET RETVAL=$$WAITSTR^ABSPOSAW(DIALOUT,"OK",20)
DO FLUSH(DIALOUT,1)
+7 IF $QUIT
QUIT RETVAL
QUIT
+8 ;
+9 ; MODEMSTS - Issue the modem's query command and log the output.
+10 ; The command comes from 9002313.54, since the query
+11 ; command varies a lot from one modem to another.
+12 ;
MODEMSTS(DIALOUT) ;EP - return 0; or you can just DO it.
+1 NEW IO,RETVAL,CMD,TIMEOUT,LOOK4OK,I,X,%
SET IO=$$IO^ABSPOSA(DIALOUT)
+2 NEW MODEMTYP
SET MODEMTYP=$$MODEMTYP^ABSPOSA(DIALOUT)
+3 SET %=$GET(^ABSP(9002313.54,MODEMTYP,"QUERY FOR STATUS"))
+4 SET CMD=$PIECE(%,U)
SET TIMEOUT=$PIECE(%,U,2)
SET LOOK4OK=$PIECE(%,U,3)
+5 ; no Inquiry command for this modem type??
IF CMD=""
IF $QUIT
QUIT 0
QUIT
+6 IF 'TIMEOUT
SET TIMEOUT=1
+7 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - QUERY - command "_CMD,$GET(ECHO))
+8 DO COMMAND^ABSPOSA(DIALOUT,CMD)
+9 USE IO
+10 FOR I=1:1
READ X(I):TIMEOUT
IF '$TEST
QUIT
IF LOOK4OK&($TRANSLATE(X(I),$CHAR(13,10),"")="OK")
QUIT
+11 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - QUERY - reply:",$GET(ECHO))
+12 FOR I=1:1
IF '$DATA(X(I))
QUIT
Begin DoDot:1
+13 DO LOG^ABSPOSL($TRANSLATE(X(I),$CHAR(13,10),""),$GET(ECHO))
End DoDot:1
+14 IF $QUIT
QUIT 0
QUIT
+15 ;
+16 ; DIAL - Issue the command to dial the phone
+17 ; and wait for the successful CONNECT 2400 response.
+18 ;
DIAL(DIALOUT) ;EP - return 0 if okay, nonzero if error
+1 NEW IO,RETVAL,DIAL
SET IO=$$IO^ABSPOSA(DIALOUT)
+2 NEW DIAL,MODEMTYP,CONNMSG
+3 SET DIAL="ATDT"_$$PHONENUM(DIALOUT)
+4 SET MODEMTYP=$$MODEMTYP^ABSPOSA(DIALOUT)
+5 SET CONNMSG=$PIECE($GET(^ABSP(9002313.54,MODEMTYP,"CONNECT MESSAGE")),U)
+6 DO LOG^ABSPOSL($TEXT(+0)_" - MODEM - DIAL - command "_DIAL,$GET(ECHO))
+7 DO COMMAND^ABSPOSA(DIALOUT,DIAL)
+8 NEW X
SET X=$TEXT(+0)_" - MODEM - DIAL - "
+9 IF CONNMSG=""
Begin DoDot:1
+10 DO LOG^ABSPOSL(X_" but no CONNECT MESSAGE in 9002313.54",$GET(ECHO))
End DoDot:1
SET RETVAL=0
+11 IF '$TEST
IF '$$WAITSTR^ABSPOSAW(DIALOUT,CONNMSG,40)
Begin DoDot:1
+12 DO LOG^ABSPOSL(X_"successful",$GET(ECHO))
End DoDot:1
SET RETVAL=0
+13 IF '$TEST
Begin DoDot:1
+14 DO LOG^ABSPOSL(X_"did not receive expected "_CONNMSG,$GET(ECHO))
End DoDot:1
SET RETVAL=1
+15 IF $QUIT
QUIT RETVAL
QUIT 0
+16 ;
+17 ; $$PHONENUM Look up the phone number for this dial out.
+18 ;
PHONENUM(N) ;
+1 NEW X,Y
+2 SET X=$PIECE($GET(^ABSP(9002313.99,1,"OUTSIDE LINE")),U)
+3 ; If you do need to dial a number to get an outside line,
+4 ; tack on a comma if needed - modem will pause to wait for
+5 ; second dial tone. (No parameter needed yet since apparently
+6 ; all modems have this feature.)
+7 IF X]""
IF $EXTRACT(X,$LENGTH(X))'=","
SET X=X_","
+8 SET Y=$$GET55FLD^ABSPOSA(N,450.01)
+9 ; local or long distance?
SET X=$PIECE(X,U,$SELECT($EXTRACT(Y)=1:1,1:2))
+10 QUIT $SELECT(Y]"":X_Y,1:"")
+11 ;
+12 ; HANGUP - Issue the hang up command.
+13 ;
HANGUP(DIALOUT) ;EP - this does nothing.
+1 ; The "W +" and timeout stuff wasn't effective.
+2 ; Just the CLOSE seems to take care of things okay at ANMC.
+3 ; This is probably the case at other sites, too.
+4 NEW IO
SET IO=$$IO^ABSPOSA(DIALOUT)
+5 GOTO HANGUP99
+6 NEW TRY,I,ANS
+7 ;
+8 ;Make sure input variables are defined
+9 IF $GET(IO)=""
QUIT
+10 ;
+11 ;Get modem into command mode, then hangup, try up to 3 times
+12 FOR TRY=1:1:3
Begin DoDot:1
+13 ;O IO
+14 HANG 1
+15 FOR I=1:1:3
USE IO
WRITE "+"
+16 HANG 2
+17 USE IO
WRITE "ATH0",!
+18 HANG 1
+19 DO IMPOSS^ABSPOSUE("P","T","Code not reachable","Obsolete subroutine/not used","HANGUP",$TEXT(+0))
+20 ;need to ; S ANS=$$WaitFor(IO,"OK",2)
End DoDot:1
IF ANS=1
QUIT
+21 ;
+22 ;Close input/output device
HANGUP99 ;D CLOSE^ABSPOSAB(DIALOUT)
+1 QUIT
