Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABSPOSAB

ABSPOSAB.m

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