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