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

ABSPOSA.m

Go to the documentation of this file. 
  1. ABSPOSA ; IHS/FCS/DRS - NO DESCRIPTION PROVIDED ;   [ 06/10/2002  10:12 AM ]
  1.  ;;1.0;PHARMACY POINT OF SALE;**2**;JUN 21, 2001;Build 38
  1.  ;
  1.  ;  ABSPOSA contains a lot of one-liner utility routines
  1.  ;  available for general use in the ABSPOSA* family.
  1.  ;  And maybe other routines, too.
  1.  Q
  1.  ;
  1.  ;  The Dial Out file, 9002313.55
  1.  ; Don't directly refer to 9002313.55 in here - use $$GET55FLD instead.
  1.  ; This resolves defaults.
  1.  ;
  1.  ;IHS/SD/lwj  06/10/02  new logic added to allow the package to work
  1.  ; in a Cache environment.  Changes added to the IO subroutine - 
  1.  ; will now check the system type, and if it is Cache, it will
  1.  ; retrieve the value in the 420.03 field of the ABSP dial Out file
  1.  ; rather than the 420.01 field that is used for standard MSM systems.
  1.  ;
  1.  ;
  1. THEDEF55()         Q $O(^ABSP(9002313.55,"B","DEFAULT",0))
  1. ISDEF55(DIALOUT)   Q $P(^ABSP(9002313.55,DIALOUT,0),U)="DEFAULT"
  1. DEF5599() ;EP - what's the default dial-out as pointed to by 9002313.99?
  1.  Q $P($G(^ABSP(9002313.99,1,"DIAL-OUT DEFAULT")),U)
  1. DEF55(DIALOUT)  ; return pointer to the dial out used to supply defaults
  1.  ; for this given dial-out.  For the DEFAULT dial out, lookup the
  1.  ; pointer in 9002313.99.  For others, they point to the default.
  1.  I $$ISDEF55(DIALOUT) Q $$DEF5599
  1.  Q $$THEDEF55
  1.  ;
  1. GET55FLD(DIALOUT,FIELD) ;EP - get dialout field value; resort to default if necessary
  1.  N X
  1.  S X=$$GET55F1(DIALOUT,FIELD) ; try the dial-out itself first
  1.  I X="" S X=$$GET55F1($$DEF55(DIALOUT),FIELD) ; else go to the default
  1.  Q X
  1. GET55F1(DIALOUT,FIELD)         ;
  1.  Q $$GET1^DIQ(9002313.55,DIALOUT_",",FIELD,"I")
  1.  ;
  1.  ; How to terminate modem commands?
  1.  ;   CR LF has been troublesome in some cases
  1.  ;   Plain old CR seems to work fine.
  1.  ;
  1. TERMATOR(DIALOUT)  ; terminate modem command with what?  CR? LF? CR LF?
  1.  Q $C(13) ; seems to work at ANMC, too.
  1.  ;I $ZV["Windows NT" Q $C(13)
  1.  ;Q $C(13,10)
  1.  ;
  1.  ;  COMMAND issues a command to the modem.
  1.  ;  If it doesn't begin with AT, then this routine supplies it.
  1.  ;
  1. COMMAND(DIALOUT,COMMAND) ;EP - from ABSPOSAB
  1.  I $E(COMMAND,1,2)'="AT" S COMMAND="AT"_COMMAND
  1.  U $$IO(DIALOUT) W COMMAND,$$TERMATOR(DIALOUT) Q
  1.  ;
  1.  ;  STATUS  returns status of the dial out device.
  1.  ;   You hope to get the result 0.
  1.  ;
  1. STATUS(DIALOUT)    ;
  1.  N IO S IO=$$IO(DIALOUT)
  1.  N ZA,ZB,ZC,RET U IO S ZA=$ZA,ZB=$ZB,ZC=$ZC
  1.  I $$TCP(DIALOUT) D
  1.  . S RET=$S(ZB=0:0,ZB=-3:0,1:ZB)
  1.  E  D
  1.  . S RET=ZC
  1.  Q RET
  1.  ;
  1.  ;  MSYSTEM()  used to return the value of the type of M system
  1.  ;    field in 9002313.99.  It's obsolete.  Not used any more.
  1.  ; If you need this functionality, use ^%ZOSF(something)
  1.  ;
  1.  ; SERVER(), PORT(), IO(), TCPSERV(), MODEMTYP() 
  1.  ;    all return information about the current dial out.
  1.  ; It uses $$GET55FLD so as to get the value from the default dial
  1.  ; out, or if not, from the dial out named DEFAULT.
  1.  ;
  1. SERVER(DIALOUT) ;EP -
  1.  Q $$GET55FLD(DIALOUT,2021.01)
  1. PORT(DIALOUT) ;EP -
  1.  Q $$GET55FLD(DIALOUT,2021.02)
  1. IO(DIALOUT) ;EP -
  1.  ;IHS/SD/ljw 06/10/02     routine altered to incorporate changes
  1.  ; needed for Cache.  If the system is Cache, we will retrieve
  1.  ; the device from the 420.03 field - if it's MSM we will use
  1.  ; the 420.01 field - both fields in ABSP Dial Out
  1.  ;
  1.  ; IHS/SD/lwj 06/10/02  begin changes
  1.  ;
  1.  N ABSPOFLD
  1.  ;
  1.  S ABSPOFLD=420.01   ;standard MSM systems device
  1.  I ^%ZOSF("OS")["OpenM" S ABSPOFLD=420.03   ;Cache device
  1.  ;
  1.  ;Q $$GET55FLD(DIALOUT,420.01)  ;remarked out - nxt line added
  1.  Q $$GET55FLD(DIALOUT,ABSPOFLD) ;new quit for either device
  1.  ;
  1.  ;IHS/SD/lwj  06/10/02  end Cache changes
  1.  ;
  1. TCP(DIALOUT) ;EP - 
  1.  N X S X=$$GET55FLD(DIALOUT,420.02) Q X=2!(X=3)
  1. TCPSERV(DIALOUT)   Q $$GET55FLD(DIALOUT,420.02)=2
  1. T1DIRECT(DIALOUT) ;EP -
  1.  Q $$GET55FLD(DIALOUT,420.02)=3
  1. MODEMTYP(DIALOUT) ;EP - 
  1.  Q $$GET55FLD(DIALOUT,.02)