BMXRPC5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
;Stolen from Mike Remillard. If it doesn't work, it's his fault.
HS(BMXGBL,BMXDFN,BMXTYPE,BMXRDL,BMXFDL) ;EP
;---> Return patient's Health Summary in global array, ^BMXTEMP($J,"HS"
;---> Lines delimited by BMXRDL
;---> File delimited by BMXFDL
;---> Called by RPC: BMX HEALTH SUMMARY
;---> Parameters:
; 1 - BMXGBL (ret) Name of result global containing patient's
; Health Summary, passed to Broker.
; 2 - BMXDFN (req) DFN of patient.
;
;---> Delimiter to pass error with result to GUI.
N BMX30,BMX31,BMXERR,X
;S BMX30=$C(30),BMX31=$C(31)_$C(31)
S BMX30=$G(BMXRDL)
I BMX30="" S BMX30=$C(13)_$C(10)
S BMX31=$G(BMXFDL)
S BMXGBL="^BMXTEMP("_$J_",""HS"")",BMXERR=""
K ^BMXTEMP($J,"HS")
;
N BMXPATH
;---> Should get path from a Site Parameter. For now, use MSM default.
S BMXPATH="/usr/spool/uucppublic/"
;S BMXPATH="C:\MSM\" ;TODO: Change to site parameter
;--->Flag to test whether running as broker job:
N BMXSOCK
S BMXSOCK=0
;I $I=56 S BMXSOCK=1
;
;---> If DFN not supplied, set Error Code and quit.
I '$G(BMXDFN) D Q
. S BMXERR="No Patient DFN" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
;
;---> If patient does not exist, set Error Code and quit.
I '$D(^AUPNPAT(BMXDFN,0)) D Q
. S BMXERR="Patient DFN does not exist" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
;
N APCHSPAT,APCHSTYP
S APCHSPAT=BMXDFN
S APCHSTYP=$G(BMXTYPE)
S:'+APCHSTYP APCHSTYP=7
;S APCHSTYP=9
;---> Doesn't work from Device 56.
;D GUIR^XBLM("EN^APCHS","^TMP(""BMXHS"",$J,")
;
;---> Generate a host file name.
N BMXFN S BMXFN="XB"_$J
;
D
.;---> Important to preserve IO variables for when $I returns to 56.
.N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY
.;
.;---> Open host file to receive legacy code display.
.S Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"W")
.;O 51:(BMXPATH_BMXFN:"W")
.;S IO=51,IOST="P-OTHER80"
.;K ^HW("HS")
.;S ^HW("HS","IOST")=$G(IOST)
.;S ^HW("HS","IO")=$G(IO)
.;
.;---> Call to legacy code for Health Summary display.
.S IOSL=999,IOM=80
.D EN^APCHS
.;---> Write End of File (EOF) marker.
.W $C(9)
.;
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
.;D ^%ZISC
.;---> Buffer won't write out to file until the device is closed
.;---> or the buffer is flushed by some other command.
.;---> At this point, host file exists but has 0 bytes.
.;C 51
.;---> Now host file contains legacy code display data.
.;
.;---> For some reason %ZISH cannot open the host file a second time.
.;S Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"R")
.;O 51:(BMXPATH_BMXFN:"R")
.U 51
.;
.;---> Read in the host file.
.D
..;---> Stop reading Host File if line contains EOF $C(9).
..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXHS",$J,I)=Y
.;
.;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
.;D ^%ZISC
.;C 51
;
;---> At this point $I=1. The job has "forgotten" its $I, even
;---> though %SS shows 56 as the current device. $I=1 causes a
;---> <NOPEN> at CAPI+10^XWBBRK2. A simple USE 56 command
;---> appears to "remind" the job its $I is 56, and it works.
;---> Possibly this is something %ZISC ordinarily does.
I BMXSOCK U 56
;U 56
;
;---> Copy Health Summary to global array for passing back to GUI.
N I,N,U,X S U="^"
S N=0
F I=1:1 S N=$O(^TMP("BMXHS",$J,N)) Q:'N D
.;---> Set null lines (line breaks) equal to one space, so that
.;---> Windows reader will quit only at the final "null" line.
.S X=^TMP("BMXHS",$J,N) S:X="" X=" "
.S ^BMXTEMP($J,"HS",I)=X_BMX30
;
;---> If no Health Summary produced, report it as an error.
D:'$O(^BMXTEMP($J,"HS",0))
. S BMXERR="No Health Summary produced" S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
;
;---> Tack on Error Delimiter and any error.
S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
;
;---> Delete host file.
;---> This doesn't work.
S Y=$$DEL^%ZISH(BMXPATH,BMXFN)
;---> Call system command.
;S ^MIKE(1)=BMXPATH
;S ^MIKE(2)=BMXFN
;S Y=$ZOS(2,BMXPATH_BMXFN)
K ^TMP("BMXHS",$J)
Q
BMXRPC5 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;Stolen from Mike Remillard. If it doesn't work, it's his fault.
HS(BMXGBL,BMXDFN,BMXTYPE,BMXRDL,BMXFDL) ;EP
+1 ;---> Return patient's Health Summary in global array, ^BMXTEMP($J,"HS"
+2 ;---> Lines delimited by BMXRDL
+3 ;---> File delimited by BMXFDL
+4 ;---> Called by RPC: BMX HEALTH SUMMARY
+5 ;---> Parameters:
+6 ; 1 - BMXGBL (ret) Name of result global containing patient's
+7 ; Health Summary, passed to Broker.
+8 ; 2 - BMXDFN (req) DFN of patient.
+9 ;
+10 ;---> Delimiter to pass error with result to GUI.
+11 NEW BMX30,BMX31,BMXERR,X
+12 ;S BMX30=$C(30),BMX31=$C(31)_$C(31)
+13 SET BMX30=$GET(BMXRDL)
+14 IF BMX30=""
SET BMX30=$CHAR(13)_$CHAR(10)
+15 SET BMX31=$GET(BMXFDL)
+16 SET BMXGBL="^BMXTEMP("_$JOB_",""HS"")"
SET BMXERR=""
+17 KILL ^BMXTEMP($JOB,"HS")
+18 ;
+19 NEW BMXPATH
+20 ;---> Should get path from a Site Parameter. For now, use MSM default.
+21 SET BMXPATH="/usr/spool/uucppublic/"
+22 ;S BMXPATH="C:\MSM\" ;TODO: Change to site parameter
+23 ;--->Flag to test whether running as broker job:
+24 NEW BMXSOCK
+25 SET BMXSOCK=0
+26 ;I $I=56 S BMXSOCK=1
+27 ;
+28 ;---> If DFN not supplied, set Error Code and quit.
+29 IF '$GET(BMXDFN)
Begin DoDot:1
+30 SET BMXERR="No Patient DFN"
SET ^BMXTEMP($JOB,"HS",I)=BMX31_BMXERR
End DoDot:1
QUIT
+31 ;
+32 ;---> If patient does not exist, set Error Code and quit.
+33 IF '$DATA(^AUPNPAT(BMXDFN,0))
Begin DoDot:1
+34 SET BMXERR="Patient DFN does not exist"
SET ^BMXTEMP($JOB,"HS",I)=BMX31_BMXERR
End DoDot:1
QUIT
+35 ;
+36 NEW APCHSPAT,APCHSTYP
+37 SET APCHSPAT=BMXDFN
+38 SET APCHSTYP=$GET(BMXTYPE)
+39 IF '+APCHSTYP
SET APCHSTYP=7
+40 ;S APCHSTYP=9
+41 ;---> Doesn't work from Device 56.
+42 ;D GUIR^XBLM("EN^APCHS","^TMP(""BMXHS"",$J,")
+43 ;
+44 ;---> Generate a host file name.
+45 NEW BMXFN
SET BMXFN="XB"_$JOB
+46 ;
+47 Begin DoDot:1
+48 ;---> Important to preserve IO variables for when $I returns to 56.
+49 NEW IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY
+50 ;
+51 ;---> Open host file to receive legacy code display.
+52 SET Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"W")
+53 ;O 51:(BMXPATH_BMXFN:"W")
+54 ;S IO=51,IOST="P-OTHER80"
+55 ;K ^HW("HS")
+56 ;S ^HW("HS","IOST")=$G(IOST)
+57 ;S ^HW("HS","IO")=$G(IO)
+58 ;
+59 ;---> Call to legacy code for Health Summary display.
+60 SET IOSL=999
SET IOM=80
+61 DO EN^APCHS
+62 ;---> Write End of File (EOF) marker.
+63 WRITE $CHAR(9)
+64 ;
+65 ;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
+66 ;D ^%ZISC
+67 ;---> Buffer won't write out to file until the device is closed
+68 ;---> or the buffer is flushed by some other command.
+69 ;---> At this point, host file exists but has 0 bytes.
+70 ;C 51
+71 ;---> Now host file contains legacy code display data.
+72 ;
+73 ;---> For some reason %ZISH cannot open the host file a second time.
+74 ;S Y=$$OPEN^%ZISH(BMXPATH,BMXFN,"R")
+75 ;O 51:(BMXPATH_BMXFN:"R")
+76 USE 51
+77 ;
+78 ;---> Read in the host file.
+79 Begin DoDot:2
+80 ;---> Stop reading Host File if line contains EOF $C(9).
+81 ;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXHS",$J,I)=Y
End DoDot:2
+82 ;
+83 ;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
+84 ;D ^%ZISC
+85 ;C 51
End DoDot:1
+86 ;
+87 ;---> At this point $I=1. The job has "forgotten" its $I, even
+88 ;---> though %SS shows 56 as the current device. $I=1 causes a
+89 ;---> <NOPEN> at CAPI+10^XWBBRK2. A simple USE 56 command
+90 ;---> appears to "remind" the job its $I is 56, and it works.
+91 ;---> Possibly this is something %ZISC ordinarily does.
+92 IF BMXSOCK
USE 56
+93 ;U 56
+94 ;
+95 ;---> Copy Health Summary to global array for passing back to GUI.
+96 NEW I,N,U,X
SET U="^"
+97 SET N=0
+98 FOR I=1:1
SET N=$ORDER(^TMP("BMXHS",$JOB,N))
IF 'N
QUIT
Begin DoDot:1
+99 ;---> Set null lines (line breaks) equal to one space, so that
+100 ;---> Windows reader will quit only at the final "null" line.
+101 SET X=^TMP("BMXHS",$JOB,N)
IF X=""
SET X=" "
+102 SET ^BMXTEMP($JOB,"HS",I)=X_BMX30
End DoDot:1
+103 ;
+104 ;---> If no Health Summary produced, report it as an error.
+105 IF '$ORDER(^BMXTEMP($JOB,"HS",0))
Begin DoDot:1
+106 SET BMXERR="No Health Summary produced"
SET ^BMXTEMP($JOB,"HS",I)=BMX31_BMXERR
End DoDot:1
+107 ;
+108 ;---> Tack on Error Delimiter and any error.
+109 SET ^BMXTEMP($JOB,"HS",I)=BMX31_BMXERR
+110 ;
+111 ;---> Delete host file.
+112 ;---> This doesn't work.
+113 SET Y=$$DEL^%ZISH(BMXPATH,BMXFN)
+114 ;---> Call system command.
+115 ;S ^MIKE(1)=BMXPATH
+116 ;S ^MIKE(2)=BMXFN
+117 ;S Y=$ZOS(2,BMXPATH_BMXFN)
+118 KILL ^TMP("BMXHS",$JOB)
+119 QUIT
