BIXCALL ;IHS/CMI/MWR - XCALL TO IMMSERVE LIBRARY; MAY 10, 2010
;;8.5;IMMUNIZATION;**2**;MAY 15,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; XCALL TO IMMSERVE LIBRARY FOR FORCASTING IMMUNIZATIONS.
;; Called from ^BIPATUP.
;; PATCH 1: Change Immserve host file names to "06". RUN+46
;
;
;----------
RUN(BIHX,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 - BIRPT (ret) String returning text version of forcast.
; 3 - BIDATA (ret) String returning data version of forcast.
; 4 - 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 ImmServe.
;W !,"BIHX: ",BIHX R ZZZ
;
S BIERR="",BIRPT="",BIDATA=""
S BIHX=BIHX_$C(10)
;
;---> BIDLLPROG is special variable--stored locally, not passed--for speed.
I $G(BIDLLPROG)="" D
.S:'$D(BISITE) BISITE=+$G(DUZ(2))
.N BIDLLPATH
.S BIDLLPATH=$$IMMSVDIR^BIUTL8(BISITE)
.I $G(BIDLLPATH)="" S BIERR=119 Q
.;
.;---> 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^BIXCALL"
.I $ZU(168,BIDLLPATH)
.I $G(BIERR)]"" Q
.;
.;---> Set ImmServe Program call.
.;W !!,"BUILDING CALL" R ZZZ ;Uncomment for testing.
.;
.;---> Patch to flag whether system is 32-bit or 64-bit.
.D
..N Y,BIT S Y=$$VERSION^%ZOSV(1)
..;
..;---> SAC Exemption from 2.2.6.2.3
..;---> This command from Intersystems is necessary to determine whether
..;---> the operating system is 32-bit or 64-bit. (Request made to VA
..;---> for future %ZOSV call.) Returns 4 for 32-bit and 8 for 64-bit.
..S BIT=$ZU(40,0,4)
..;
..;********** VERSION 8.4, v8.4, APR 15,2010, IHS/CMI/MWR
..;---> Change to "02" for new Immserve, e.g., biwin3202 instead of biwin3201.
..;---> Change to "04" for new Immserve, e.g., biwin3204 instead of biwin3202.
..;********** VERSION 8.5, JUL 01,2011, IHS/CMI/MWR
..;---> Change to "05" for new Immserve, e.g., biwin3205 instead of biwin3204.
..;********** VERSION 8.52, MAY 15,2012, IHS/CMI/MWR
..;---> Change to "06" for new Immserve, e.g., biwin3206 instead of biwin3205.
..;
..I ((Y["Windows")&(BIT=8)) S BIDLLPROG="biwin6406.dll" Q
..I Y["Windows" S BIDLLPROG="biwin3206.dll" Q
..I ((Y["Linux")&(BIT=8)) S BIDLLPROG="bilin6406.so" Q
..I Y["Linux" S BIDLLPROG="bilin3206.so" Q
..I ((Y["Solaris")&(BIT=8)) S BIDLLPROG="bisol6406.so" Q
..I ((Y["UNIX")&(BIT=8)) S BIDLLPROG="biaix6406.so" Q
..I Y["UNIX" S BIDLLPROG="biaix3206.so" Q
..;---> NEXT LINE: Good for calling a new version conditional upon Immserve path.
..;I ((Y["UNIX")&(BIT=8)) S BIDLLPROG="biaix6403.so" S:BIDLLPATH["84a" BIDLLPROG="biaix6404.so" Q
..;**********
..;
..I $G(BIDLLPROG)="" S BIERR=120 Q
.;---> Now prepend the path.
.S BIDLLPROG=BIDLLPATH_BIDLLPROG
I $G(BIERR)]"" Q
;
;---> SAC Exemption from 2.2.3.3.2
;---> Purpose: To trap error during Cache proprietary call to Immserve library.
;---> SAC Exemption Memo dated Feb 2004.
S $ZT="ERRTRAP1^BIXCALL"
;
;---> Load the DLL if it is not already in the partition.
I '$G(BIDLLID)!('$G(BIDLLRUN)) D LOAD(BIDLLPROG,.BIDLLID,.BIDLLRUN,.BIERR)
I BIERR S (BIRPT,BIDATA,BIERR)=$$ERROR^BIXCALL(BIERR) Q
;
S BIHX=BIHX_$C(10)
;
;---> SAC Exemption from 2.2.6.2.3
;---> Purpose: Cache proprietary call to Immserve commercial forecasting
;---> software. This applies to all $ZF calls in this routine.
;---> SAC Exemption Memo dated Feb 2004.
;---> Dimitri Fane's ZF call to Fred Sayward's library.
S BIRESULT=$ZF(-5,BIDLLID,BIDLLRUN,"",BIHX,"",8192,"",8192)
;
;---> For Testing, uncomment next line to see the raw data returned
;---> from ImmServe:
;W !!!,BIRESULT R ZZZ
;
S BIERR=$P(BIRESULT,"&&&,",1)
I BIERR S (BIRPT,BIDATA,BIERR)=$$ERROR^BIXCALL(BIERR) Q
S BIDATA=$P(BIRESULT,"&&&,",2)
S BIRPT=$P(BIRESULT,"&&&,",3)
S:BIERR=0 BIERR=""
;
;N X,Y
;S X=$P(BIDATA,"Female"),Y=$P(BIDATA,"Female",2)
;S BIDATA=X_"Female^"_Y
;
Q
;
;
;----------
LOAD(BIDLLPROG,BIDLLID,BIDLLRUN,BIERR) ;EP
;W !,"LOADING..." R ZZZ ;Uncomment for testing.
;---> Cache Load and initialize Immserve Forecast Library.
;---> This load may be run repeatedly in the same partition, however
;---> for the sake of performance it should only be called the
;---> first time. Test for BIDLLID and BIDLLRUN determines whether
;---> this gets called or not.
;---> Parameters:
; 1 - BIDLLPROG (req) Path and name of ImmServe Program call.
; 2 - BIDLLID (ret) Index number to the DLL.
; 3 - BIDLLRUN (ret) Index number to the RUN function of the DLL.
; 4 - BIERR (ret) Error code if DLL not loaded successfully.
;
;---> $ZF(-4,1,path) loads a DLL and returns the index number to the DLL.
S BIDLLID=$ZF(-4,1,BIDLLPROG)
I '$G(BIDLLID) S BIERR=997 Q
;
;---> $ZF(-4,3,BIDLLID,function) returns the index number of the function
;---> in the DLL described by BIDLLID.
;---> Next line: IMM_IHS (load and run in one call) not used.
;S BIDLLRUN=$ZF(-4,3,BIDLLID,"IMM_ASCII")
N BILOAD
S BILOAD=$ZF(-4,3,BIDLLID,"IMM_ASCII_LOAD")
S BIDLLRUN=$ZF(-4,3,BIDLLID,"IMM_ASCII_RUN")
I '$G(BIDLLRUN) S BIERR=996 Q
S BIERR=$P($ZF(-5,BIDLLID,BILOAD,""),"&&&")
Q
;
;
;----------
ERROR(BIERRNUM) ;EP
;---> Return text of error, based on number passed.
;---> Parameters:
; 1 - BIERRNUM (req) Numeric value of error.
;
Q "BICALL Error: "_$$ERRMSG(BIERRNUM)
;
;
;----------
ERRMSG(X) ;EP
;---> Error messages.
Q:X=1 "1;Some cases could not be processed."
Q:X=-1 "-1;Cannot find, open, load the Versions/Variants file."
Q:X=-2 "-2;Cannot find, open, load Imm/Def table file."
Q:X=-3 "-3;Cannot find, open, load Screening table file."
Q:X=-4 "-4;Cannot find, open, load Live Vaccine Table file."
Q:X=-5 "-5;Cannot find, open, load Facts defining constants file."
Q:X=-6 "-6;Cannot find, open, load VFC eligibility file."
Q:X=-7 "-7;Cannot find, open, load Knowledge Base file."
Q:X=-8 "-8;Cannot initialize time tables."
Q:X=-9 "-9;Cannot initialize timeline."
Q:X=-10 "-10;Input carot string is empty."
Q:X=-11 "-11;Input case not terminated with new line."
Q:X=-12 "-12;Cannot convert a carot notation input case."
Q:X=-13 "-13;Cannot initialize global data structures."
Q:X=-14 "-14;Internal report writer buffer overflow."
Q:X=-15 "-15;Internal report writer fatal error."
Q:X=-16 "-16;Interface report buffer overflow."
Q:X=-17 "-17;Cannot convert to carot notation output."
Q:X=-18 "-18;Interface output buffer overflow."
Q:X=-19 "-19;Fatal runtime error."
Q:X=-99 "-99;Immserve not loaded into memory. D LOAD^BIXCALL."
Q:X=100 "100;Report Buffer must be at least 80."
Q:X=200 "200;Data Buffer must be at least 80."
Q:X=101 "101;Report buffer too small for report."
Q:X=201 "201;Data buffer too small for data."
Q:X=996 "996;Failure to obtain Immserve DLL RUN number."
Q:X=997 "997;Failure to obtain Immserve DLL ID number."
Q:X=998 "998;Immserve path not provided."
Q:X=999 "999;Patient Immunization History data not provided."
Q:X=9999 "9999;XCALL Failure (Immserve file not loaded)."
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(118,.BIERR)
Q
;
;
;----------
ERRTRAP1 ;EP
;---> Error trap for Invalid ImmServe library call.
D ERRCD^BIUTL2(122,.BIERR)
Q
BIXCALL ;IHS/CMI/MWR - XCALL TO IMMSERVE LIBRARY; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**2**;MAY 15,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; XCALL TO IMMSERVE LIBRARY FOR FORCASTING IMMUNIZATIONS.
+4 ;; Called from ^BIPATUP.
+5 ;; PATCH 1: Change Immserve host file names to "06". RUN+46
+6 ;
+7 ;
+8 ;----------
RUN(BIHX,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 - BIRPT (ret) String returning text version of forcast.
+7 ; 3 - BIDATA (ret) String returning data version of forcast.
+8 ; 4 - BIERR (ret) String returning text of error code.
+9 ;
+10 ;---> Quit if Patient IMM Hx not provided.
+11 IF $GET(BIHX)=""
SET (BIRPT,BIDATA,BIERR)=$$ERROR(999)
QUIT
+12 ;
+13 ;---> Uncomment to see Patient History sent to ImmServe.
+14 ;W !,"BIHX: ",BIHX R ZZZ
+15 ;
+16 SET BIERR=""
SET BIRPT=""
SET BIDATA=""
+17 SET BIHX=BIHX_$CHAR(10)
+18 ;
+19 ;---> BIDLLPROG is special variable--stored locally, not passed--for speed.
+20 IF $GET(BIDLLPROG)=""
Begin DoDot:1
+21 IF '$DATA(BISITE)
SET BISITE=+$GET(DUZ(2))
+22 NEW BIDLLPATH
+23 SET BIDLLPATH=$$IMMSVDIR^BIUTL8(BISITE)
+24 IF $GET(BIDLLPATH)=""
SET BIERR=119
QUIT
+25 ;
+26 ;---> SAC Exemption from 2.2.3.3.2
+27 ;---> Purpose: Cache proprietary call to check/set Immserve directory.
+28 ;---> SAC Exemption Memo dated Feb 2004.
+29 SET $ZT="ERRTRAP^BIXCALL"
+30 IF $ZU(168,BIDLLPATH)
+31 IF $GET(BIERR)]""
QUIT
+32 ;
+33 ;---> Set ImmServe Program call.
+34 ;W !!,"BUILDING CALL" R ZZZ ;Uncomment for testing.
+35 ;
+36 ;---> Patch to flag whether system is 32-bit or 64-bit.
+37 Begin DoDot:2
+38 NEW Y,BIT
SET Y=$$VERSION^%ZOSV(1)
+39 ;
+40 ;---> SAC Exemption from 2.2.6.2.3
+41 ;---> This command from Intersystems is necessary to determine whether
+42 ;---> the operating system is 32-bit or 64-bit. (Request made to VA
+43 ;---> for future %ZOSV call.) Returns 4 for 32-bit and 8 for 64-bit.
+44 SET BIT=$ZU(40,0,4)
+45 ;
+46 ;********** VERSION 8.4, v8.4, APR 15,2010, IHS/CMI/MWR
+47 ;---> Change to "02" for new Immserve, e.g., biwin3202 instead of biwin3201.
+48 ;---> Change to "04" for new Immserve, e.g., biwin3204 instead of biwin3202.
+49 ;********** VERSION 8.5, JUL 01,2011, IHS/CMI/MWR
+50 ;---> Change to "05" for new Immserve, e.g., biwin3205 instead of biwin3204.
+51 ;********** VERSION 8.52, MAY 15,2012, IHS/CMI/MWR
+52 ;---> Change to "06" for new Immserve, e.g., biwin3206 instead of biwin3205.
+53 ;
+54 IF ((Y["Windows")&(BIT=8))
SET BIDLLPROG="biwin6406.dll"
QUIT
+55 IF Y["Windows"
SET BIDLLPROG="biwin3206.dll"
QUIT
+56 IF ((Y["Linux")&(BIT=8))
SET BIDLLPROG="bilin6406.so"
QUIT
+57 IF Y["Linux"
SET BIDLLPROG="bilin3206.so"
QUIT
+58 IF ((Y["Solaris")&(BIT=8))
SET BIDLLPROG="bisol6406.so"
QUIT
+59 IF ((Y["UNIX")&(BIT=8))
SET BIDLLPROG="biaix6406.so"
QUIT
+60 IF Y["UNIX"
SET BIDLLPROG="biaix3206.so"
QUIT
+61 ;---> NEXT LINE: Good for calling a new version conditional upon Immserve path.
+62 ;I ((Y["UNIX")&(BIT=8)) S BIDLLPROG="biaix6403.so" S:BIDLLPATH["84a" BIDLLPROG="biaix6404.so" Q
+63 ;**********
+64 ;
+65 IF $GET(BIDLLPROG)=""
SET BIERR=120
QUIT
End DoDot:2
+66 ;---> Now prepend the path.
+67 SET BIDLLPROG=BIDLLPATH_BIDLLPROG
End DoDot:1
+68 IF $GET(BIERR)]""
QUIT
+69 ;
+70 ;---> SAC Exemption from 2.2.3.3.2
+71 ;---> Purpose: To trap error during Cache proprietary call to Immserve library.
+72 ;---> SAC Exemption Memo dated Feb 2004.
+73 SET $ZT="ERRTRAP1^BIXCALL"
+74 ;
+75 ;---> Load the DLL if it is not already in the partition.
+76 IF '$GET(BIDLLID)!('$GET(BIDLLRUN))
DO LOAD(BIDLLPROG,.BIDLLID,.BIDLLRUN,.BIERR)
+77 IF BIERR
SET (BIRPT,BIDATA,BIERR)=$$ERROR^BIXCALL(BIERR)
QUIT
+78 ;
+79 SET BIHX=BIHX_$CHAR(10)
+80 ;
+81 ;---> SAC Exemption from 2.2.6.2.3
+82 ;---> Purpose: Cache proprietary call to Immserve commercial forecasting
+83 ;---> software. This applies to all $ZF calls in this routine.
+84 ;---> SAC Exemption Memo dated Feb 2004.
+85 ;---> Dimitri Fane's ZF call to Fred Sayward's library.
+86 SET BIRESULT=$ZF(-5,BIDLLID,BIDLLRUN,"",BIHX,"",8192,"",8192)
+87 ;
+88 ;---> For Testing, uncomment next line to see the raw data returned
+89 ;---> from ImmServe:
+90 ;W !!!,BIRESULT R ZZZ
+91 ;
+92 SET BIERR=$PIECE(BIRESULT,"&&&,",1)
+93 IF BIERR
SET (BIRPT,BIDATA,BIERR)=$$ERROR^BIXCALL(BIERR)
QUIT
+94 SET BIDATA=$PIECE(BIRESULT,"&&&,",2)
+95 SET BIRPT=$PIECE(BIRESULT,"&&&,",3)
+96 IF BIERR=0
SET BIERR=""
+97 ;
+98 ;N X,Y
+99 ;S X=$P(BIDATA,"Female"),Y=$P(BIDATA,"Female",2)
+100 ;S BIDATA=X_"Female^"_Y
+101 ;
+102 QUIT
+103 ;
+104 ;
+105 ;----------
LOAD(BIDLLPROG,BIDLLID,BIDLLRUN,BIERR) ;EP
+1 ;W !,"LOADING..." R ZZZ ;Uncomment for testing.
+2 ;---> Cache Load and initialize Immserve Forecast Library.
+3 ;---> This load may be run repeatedly in the same partition, however
+4 ;---> for the sake of performance it should only be called the
+5 ;---> first time. Test for BIDLLID and BIDLLRUN determines whether
+6 ;---> this gets called or not.
+7 ;---> Parameters:
+8 ; 1 - BIDLLPROG (req) Path and name of ImmServe Program call.
+9 ; 2 - BIDLLID (ret) Index number to the DLL.
+10 ; 3 - BIDLLRUN (ret) Index number to the RUN function of the DLL.
+11 ; 4 - BIERR (ret) Error code if DLL not loaded successfully.
+12 ;
+13 ;---> $ZF(-4,1,path) loads a DLL and returns the index number to the DLL.
+14 SET BIDLLID=$ZF(-4,1,BIDLLPROG)
+15 IF '$GET(BIDLLID)
SET BIERR=997
QUIT
+16 ;
+17 ;---> $ZF(-4,3,BIDLLID,function) returns the index number of the function
+18 ;---> in the DLL described by BIDLLID.
+19 ;---> Next line: IMM_IHS (load and run in one call) not used.
+20 ;S BIDLLRUN=$ZF(-4,3,BIDLLID,"IMM_ASCII")
+21 NEW BILOAD
+22 SET BILOAD=$ZF(-4,3,BIDLLID,"IMM_ASCII_LOAD")
+23 SET BIDLLRUN=$ZF(-4,3,BIDLLID,"IMM_ASCII_RUN")
+24 IF '$GET(BIDLLRUN)
SET BIERR=996
QUIT
+25 SET BIERR=$PIECE($ZF(-5,BIDLLID,BILOAD,""),"&&&")
+26 QUIT
+27 ;
+28 ;
+29 ;----------
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 "BICALL 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 IF X=-1
QUIT "-1;Cannot find, open, load the Versions/Variants file."
+4 IF X=-2
QUIT "-2;Cannot find, open, load Imm/Def table file."
+5 IF X=-3
QUIT "-3;Cannot find, open, load Screening table file."
+6 IF X=-4
QUIT "-4;Cannot find, open, load Live Vaccine Table file."
+7 IF X=-5
QUIT "-5;Cannot find, open, load Facts defining constants file."
+8 IF X=-6
QUIT "-6;Cannot find, open, load VFC eligibility file."
+9 IF X=-7
QUIT "-7;Cannot find, open, load Knowledge Base file."
+10 IF X=-8
QUIT "-8;Cannot initialize time tables."
+11 IF X=-9
QUIT "-9;Cannot initialize timeline."
+12 IF X=-10
QUIT "-10;Input carot string is empty."
+13 IF X=-11
QUIT "-11;Input case not terminated with new line."
+14 IF X=-12
QUIT "-12;Cannot convert a carot notation input case."
+15 IF X=-13
QUIT "-13;Cannot initialize global data structures."
+16 IF X=-14
QUIT "-14;Internal report writer buffer overflow."
+17 IF X=-15
QUIT "-15;Internal report writer fatal error."
+18 IF X=-16
QUIT "-16;Interface report buffer overflow."
+19 IF X=-17
QUIT "-17;Cannot convert to carot notation output."
+20 IF X=-18
QUIT "-18;Interface output buffer overflow."
+21 IF X=-19
QUIT "-19;Fatal runtime error."
+22 IF X=-99
QUIT "-99;Immserve not loaded into memory. D LOAD^BIXCALL."
+23 IF X=100
QUIT "100;Report Buffer must be at least 80."
+24 IF X=200
QUIT "200;Data Buffer must be at least 80."
+25 IF X=101
QUIT "101;Report buffer too small for report."
+26 IF X=201
QUIT "201;Data buffer too small for data."
+27 IF X=996
QUIT "996;Failure to obtain Immserve DLL RUN number."
+28 IF X=997
QUIT "997;Failure to obtain Immserve DLL ID number."
+29 IF X=998
QUIT "998;Immserve path not provided."
+30 IF X=999
QUIT "999;Patient Immunization History data not provided."
+31 IF X=9999
QUIT "9999;XCALL Failure (Immserve file not loaded)."
+32 QUIT "99999;Unknown error"
+33 ;
+34 ;
+35 ;----------
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(118,.BIERR)
+9 QUIT
+10 ;
+11 ;
+12 ;----------
ERRTRAP1 ;EP
+1 ;---> Error trap for Invalid ImmServe library call.
+2 DO ERRCD^BIUTL2(122,.BIERR)
+3 QUIT
