BIXTCH ;IHS/CMI/MWR - XCALL TO TCH FORECASTER; MAY 10, 2010
;;8.5;IMMUNIZATION;**9**;OCT 01,2014
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; XCALL TO TCH FOR FORCASTING IMMUNIZATIONS.
;; Called from ^BIPATUP.
;; PATCH 8: New routine to accommodate new TCH Forecaster RUN+0
;; PATCH 9: Add DUZ2 to retrieve IP address for call to TCH. RUN+0
;
SAMPLE ;
;---> Sample Cache Device handling code to interact with TCH Java Forecaster.
;---> 6708 is the TCH Forecaster default port (can change in the OS command).
O "|TCP|4":("127.0.0.1":6708::):10
U "|TCP|4"
W "Bonjour, Monsier le Monde",!
U "|TCP|4" R X:1
C "|TCP|4"
U 0 W !,X
Q
;
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
;----------
RUN(BIHX,BIDUZ2,BIRPT,BIDATA,BIERR) ;EP
;---> Entry point for XCALL to Immserve Forecast Library.
;---> Patient's Immunization History is supplied; ImmServe Forecast
;---> is returned as text profile (BIRPT) and as data string (BIDATA).
;---> Parameters:
; 1 - BIHX (req) String containing Patient's Immunization History.
; 2 - BIDUZ2 (req) User's DUZ(2) to indicate IP address for TCH.
; 3 - BIRPT (ret) String returning text version of forcast.
; 4 - BIDATA (ret) String returning data version of forcast.
; 5 - BIERR (ret) String returning text of error code.
;
;---> Quit if Patient IMM Hx not provided.
I $G(BIHX)="" S (BIRPT,BIDATA,BIERR)=$$ERROR(999) Q
;
;---> Uncomment to see Patient History sent to TCH Forecaster.
;W !,"Full Input String: ",BIHX R ZZZ
;
S BIERR="",BIRPT="",BIDATA=""
S BIHX=BIHX_$C(10)
N BIRESULT
;
;---> SAC Exemption from 2.2.3.3.2
;---> Purpose: Cache proprietary call to check/set Immserve directory.
;---> SAC Exemption Memo dated Feb 2004.
S $ZT="ERRTRAP^BIXTCH"
;
;---> Preserve the current Device to return to after using TCP.
N BIDEVICE S BIDEVICE=$IO
;
;---> Open TCP in Streaming Mode (to accommodate greater data length.).
;
;---> Get IP address for TCH Forecaster.
I '$G(BIDUZ2) S (BIRPT,BIDATA,BIERR)=$$ERROR(124) Q
N BIIP S BIIP=$$IPTCH^BIUTL8(BIDUZ2)
I BIIP="" S (BIRPT,BIDATA,BIERR)=$$ERROR(125) Q
;
;O "|TCP|4":("127.0.0.1":6708:"S":):3
O "|TCP|4":(BIIP:6708:"S":):3
;**********
;
U "|TCP|4"
W BIHX,!
U "|TCP|4" R BIRESULT:1
C "|TCP|4"
;
;---> Return to using previous Device.
U BIDEVICE
;
;---> For Testing, uncomment next line to see the raw data returned from TCH:
;W !,$L(BIRESULT) R ZZZ
;W !!!,"Result directly back from forecaster (in BIXTCH): ",!,BIRESULT,!! R ZZZ
;
S BIERR=$P(BIRESULT,"&&&",1)
I BIERR]"" S (BIRPT,BIDATA,BIERR)=BIERR Q
;I BIERR]"" S (BIRPT,BIDATA,BIERR)=$$ERROR^BIXTCH(BIERR) Q
S BIDATA=$P(BIRESULT,"&&&",2)
S BIRPT=$P(BIRESULT,"&&&",3)
S:BIERR=0 BIERR=""
;
Q
;
;
;----------
ERROR(BIERRNUM) ;EP
;---> Return text of error, based on number passed.
;---> Parameters:
; 1 - BIERRNUM (req) Numeric value of error.
;
Q "BIXTCH Error: "_$$ERRMSG(BIERRNUM)
;
;
;----------
ERRMSG(X) ;EP
;---> Error messages.
Q:X=1 "1;Some cases could not be processed."
Q "99999;Unknown error"
;
;
;----------
ERRTRAP ;EP
;---> Error trap for Invalid ImmServe Path.
;---> Attempt to open Host File Server.
;---> SAC Exemption from 2.4.3.1, 2.4.9.1, 2.4.11.1.
;---> Purpose: to address HFS for forecasting without changing
;---> the current display/print Device and its IO characteristics.
;---> SAC Exemption Memo dated 1 Nov 99.
;
D ERRCD^BIUTL2(123,.BIERR)
Q
BIXTCH ;IHS/CMI/MWR - XCALL TO TCH FORECASTER; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; XCALL TO TCH FOR FORCASTING IMMUNIZATIONS.
+4 ;; Called from ^BIPATUP.
+5 ;; PATCH 8: New routine to accommodate new TCH Forecaster RUN+0
+6 ;; PATCH 9: Add DUZ2 to retrieve IP address for call to TCH. RUN+0
+7 ;
SAMPLE ;
+1 ;---> Sample Cache Device handling code to interact with TCH Java Forecaster.
+2 ;---> 6708 is the TCH Forecaster default port (can change in the OS command).
+3 OPEN "|TCP|4":("127.0.0.1":6708::):10
+4 USE "|TCP|4"
+5 WRITE "Bonjour, Monsier le Monde",!
+6 USE "|TCP|4"
READ X:1
+7 CLOSE "|TCP|4"
+8 USE 0
WRITE !,X
+9 QUIT
+10 ;
+11 ;
+12 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+13 ;---> Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
+14 ;----------
RUN(BIHX,BIDUZ2,BIRPT,BIDATA,BIERR) ;EP
+1 ;---> Entry point for XCALL to Immserve Forecast Library.
+2 ;---> Patient's Immunization History is supplied; ImmServe Forecast
+3 ;---> is returned as text profile (BIRPT) and as data string (BIDATA).
+4 ;---> Parameters:
+5 ; 1 - BIHX (req) String containing Patient's Immunization History.
+6 ; 2 - BIDUZ2 (req) User's DUZ(2) to indicate IP address for TCH.
+7 ; 3 - BIRPT (ret) String returning text version of forcast.
+8 ; 4 - BIDATA (ret) String returning data version of forcast.
+9 ; 5 - BIERR (ret) String returning text of error code.
+10 ;
+11 ;---> Quit if Patient IMM Hx not provided.
+12 IF $GET(BIHX)=""
SET (BIRPT,BIDATA,BIERR)=$$ERROR(999)
QUIT
+13 ;
+14 ;---> Uncomment to see Patient History sent to TCH Forecaster.
+15 ;W !,"Full Input String: ",BIHX R ZZZ
+16 ;
+17 SET BIERR=""
SET BIRPT=""
SET BIDATA=""
+18 SET BIHX=BIHX_$CHAR(10)
+19 NEW BIRESULT
+20 ;
+21 ;---> SAC Exemption from 2.2.3.3.2
+22 ;---> Purpose: Cache proprietary call to check/set Immserve directory.
+23 ;---> SAC Exemption Memo dated Feb 2004.
+24 SET $ZT="ERRTRAP^BIXTCH"
+25 ;
+26 ;---> Preserve the current Device to return to after using TCP.
+27 NEW BIDEVICE
SET BIDEVICE=$IO
+28 ;
+29 ;---> Open TCP in Streaming Mode (to accommodate greater data length.).
+30 ;
+31 ;---> Get IP address for TCH Forecaster.
+32 IF '$GET(BIDUZ2)
SET (BIRPT,BIDATA,BIERR)=$$ERROR(124)
QUIT
+33 NEW BIIP
SET BIIP=$$IPTCH^BIUTL8(BIDUZ2)
+34 IF BIIP=""
SET (BIRPT,BIDATA,BIERR)=$$ERROR(125)
QUIT
+35 ;
+36 ;O "|TCP|4":("127.0.0.1":6708:"S":):3
+37 OPEN "|TCP|4":(BIIP:6708:"S":):3
+38 ;**********
+39 ;
+40 USE "|TCP|4"
+41 WRITE BIHX,!
+42 USE "|TCP|4"
READ BIRESULT:1
+43 CLOSE "|TCP|4"
+44 ;
+45 ;---> Return to using previous Device.
+46 USE BIDEVICE
+47 ;
+48 ;---> For Testing, uncomment next line to see the raw data returned from TCH:
+49 ;W !,$L(BIRESULT) R ZZZ
+50 ;W !!!,"Result directly back from forecaster (in BIXTCH): ",!,BIRESULT,!! R ZZZ
+51 ;
+52 SET BIERR=$PIECE(BIRESULT,"&&&",1)
+53 IF BIERR]""
SET (BIRPT,BIDATA,BIERR)=BIERR
QUIT
+54 ;I BIERR]"" S (BIRPT,BIDATA,BIERR)=$$ERROR^BIXTCH(BIERR) Q
+55 SET BIDATA=$PIECE(BIRESULT,"&&&",2)
+56 SET BIRPT=$PIECE(BIRESULT,"&&&",3)
+57 IF BIERR=0
SET BIERR=""
+58 ;
+59 QUIT
+60 ;
+61 ;
+62 ;----------
ERROR(BIERRNUM) ;EP
+1 ;---> Return text of error, based on number passed.
+2 ;---> Parameters:
+3 ; 1 - BIERRNUM (req) Numeric value of error.
+4 ;
+5 QUIT "BIXTCH Error: "_$$ERRMSG(BIERRNUM)
+6 ;
+7 ;
+8 ;----------
ERRMSG(X) ;EP
+1 ;---> Error messages.
+2 IF X=1
QUIT "1;Some cases could not be processed."
+3 QUIT "99999;Unknown error"
+4 ;
+5 ;
+6 ;----------
ERRTRAP ;EP
+1 ;---> Error trap for Invalid ImmServe Path.
+2 ;---> Attempt to open Host File Server.
+3 ;---> SAC Exemption from 2.4.3.1, 2.4.9.1, 2.4.11.1.
+4 ;---> Purpose: to address HFS for forecasting without changing
+5 ;---> the current display/print Device and its IO characteristics.
+6 ;---> SAC Exemption Memo dated 1 Nov 99.
+7 ;
+8 DO ERRCD^BIUTL2(123,.BIERR)
+9 QUIT
