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

BOPRNEW.m

Go to the documentation of this file. 
  1. BOPRNEW ;IHS/ILC/ALG/CIA/PLS - ILC Listener;06-Feb-2007 21:19;SM
  1.  ;;1.0;AUTOMATED DISPENSING INTERFACE;**1,3**;Jul 26, 2005
  1.  Q
  1. DEBUG ;Call here for testing
  1.  D DT^DICRW
  1.  S BOPLSOC=9002,BOPDIV=1
  1.  ;
  1.  ;Entry used as "ZTRTN" in BOPOMTR
  1. GO ; EP
  1.  I $G(BOPDIV)="" S BOPDIV=1
  1.  ;
  1.  ;Quit if Channel Active field set to NO for Receiving Facility
  1.  I '$P($G(^BOP(90355,1,3,BOPDIV,0)),U,2) G QUIT
  1.  ;Quit if STOP field set to INTERFACE STOPPED
  1.  I $P($G(^BOP(90355,1,12)),U,1)+0>0 G QUIT
  1.  ;
  1.  ;Lock / Test / Quit if a job is already running
  1.  L +^BOP(90355,"L",BOPDIV):99 E  Q
  1.  ;
  1.  ;Listen on socket, start routine
  1.  N %A,ZISOS,X,NIO S ZISOS=^%ZOSF("OS")
  1.  ;IHS exemption approved on March 16, 2005
  1.  I $$NEWERR^%ZTER() N $ETRAP S $ETRAP="D ERR^BOPRNEW"
  1.  E  S X="ERR^BOPRNEW",@^%ZOSF("TRAP")
  1.  ;
  1.  ;Open a channel. Parameter 1 is Socket, parameter 2 is the routine.
  1.  ;S IO("C")=1 ; If not commented out, the channel stops after 1 message
  1.  ;
  1.  ;If this side is supposed to be the client, make the connection
  1.  I $P(^BOP(90355,1,3,BOPDIV,0),U,8)="C" S X=^(0) D
  1.  .S BOPLSOC=$P(X,U,5),X=$P(X,U,3)
  1.  .D CALL^%ZISTCP(X,BOPLSOC) Q:POP
  1.  .D READ
  1.  .K BOPLSOC
  1.  ;
  1. QUIT Q
  1.  ;
  1. READ ;LISTEN^%ZISTCP will call here to read the message.
  1.  S DIQUIET=1,BOPBUF="" D DT^DICRW
  1.  ;
  1. LOOP U IO R X:1 H 1
  1.  I $P($G(^BOP(90355,1,12)),U,1)+0>0 G QUIT ; all interfaces stopped
  1.  I '$L(X) H 5 G LOOP:+$G(^BOP(90355,1,4)),QUIT
  1.  S BOPBUF=X
  1. LOOP1 D RECEIVE(2)
  1.  I $P($G(^BOP(90355,1,12)),U,1)+0>0 G QUIT ; all interfaces stopped
  1.  I +$G(^BOP(90355,1,4)) G LOOP1:$L(BOPBUF),LOOP
  1.  G QUIT
  1.  ;
  1. RECEIVE(BOPWAIT) ;
  1.  N I,J
  1.  ;
  1.  K BOPIN S BOPI=0,U="^" U IO
  1.  ;Calculate Operating System to be able to read properly
  1.  I '$D(BOPOS) S BOPOS=^%ZOSF("OS")
  1.  I BOPOS["MSM" G RMSM
  1.  G RR
  1.  ;
  1.  K BOPIN S BOPI=0,U="^" U IO
  1.  ;
  1. RMSM ; go here if MSM
  1.  S BOPOS("MSMVER")=$$VERSION^%ZOSV()
  1.  S:+BOPOS("MSMVER")=0 BOPOS("MSMVER")=8
  1.  ;
  1.  ;Read
  1.  ;If there are multiple records, BOPIN needs to be
  1.  ;changed to a global array.
  1.  ;
  1. RR ;
  1.  F  D R(BOPWAIT,BOPOS) Q:$S(X="":1,X=$C(28):1,1:"")  D
  1.  .I $E(X)=$C(11) S X=$E(X,2,$L(X)) Q:X=""
  1.  .S BOPI=BOPI+1,BOPIN(BOPI)=X
  1.  ;
  1.  ;Quit if no data received
  1.  Q:'$D(BOPIN)
  1.  ;
  1.  ;Quit if the wrong type of record
  1.  S I=":"_$P($P(BOPIN(1),"|",9),U)_":"
  1.  Q:":DFT:EPQ:EOQ:ETO:"'[I
  1.  ;
  1.  D RSET
  1.  I BOPBUF'="" K BOPIN S BOPI=0 G RR
  1.  Q
  1.  ;
  1. RSET ; file new transaction
  1.  ;Create NEW Record
  1.  ;
  1.  ;First calculate now
  1.  S DIC="^BOP(90355.1,"
  1.  S X=$$NOW^XLFDT()
  1.  ;
  1.  ;Then make sure NOW is unique in the file
  1.  L +^BOP(90355.1,0):1
  1.  F I=X:.000001 Q:'$D(^BOP(90355.1,"B",I))
  1.  K DD,DO S X=I,DIC="^BOP(90355.1,",DIC(0)="F" D FILE^DICN
  1.  L -^BOP(90355.1,0)
  1.  ;
  1.  ;Put data into file -- first mark it "NOT COMPLETE"
  1.  S DIE=90355.1,DR=".1///99;.12///"_BOPDIV_";99///1;99.1///1",DA=+Y
  1.  D ^DIE
  1.  ;
  1.  ;Put data into file
  1.  S J=0 F I=0:0 S I=$O(BOPIN(I)) Q:I<1  S J=J+1,^BOP(90355.1,DA,"DATA",J,0)=BOPIN(I)
  1.  S ^BOP(90355.1,DA,"DATA",0)=U_U_J_U_J_U_$P(^BOP(90355.1,DA,0),".")
  1.  ;
  1.  ;Mark transaction received and Acknowledge
  1.  S DIE=90355.1,DR="99.1///0" D ^DIE S BOPSTOP=1
  1.  S ^BOP(90355.1,"AC",0,DA)=""
  1.  ;  send ack back
  1.  K OUT N A,B S A=BOPIN(1),$P(A,"|",9)="ACK"
  1.  S B=$P(A,"|",2) S:B'["&" B=B_"&",$P(A,"|",2)=B
  1.  S B="MSA|AA|"_DA_"|"
  1.  S OUT(1)=$C(11)_A_$C(13),OUT(2)=B_$C(13)_$C(28)_$C(13)
  1.  S A=0 F  S A=$O(OUT(A)) Q:'A  U IO W OUT(A),!
  1.  ; keep copy in file
  1.  S OUT(0)=$H M ^BOP(90355.1,DA,"OUT")=OUT
  1.  K OUT,A,B
  1.  Q
  1.  ;
  1. RACK ; send ack back
  1. ERR ;
  1.  G QUIT
  1.  ;
  1.  ;Job out at this line to start a new receiver at single division site.
  1. JOB N ZTIO,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTSK
  1.  S ZTIO="",ZTDTH=$H,ZTRTN="JOBGO^BOPRNEW",ZTDESC="BOP LISTENER"
  1.  D ^%ZTLOAD
  1.  I '$G(ZTSK) D
  1.  .W !,"BOPRNEW job startup Failed"
  1.  Q
  1. JOBGO ;Start a new listener
  1.  S X="Automated Dispense "_$J D SETENV^%ZOSV,DT^DICRW
  1.  S I=$O(^BOP(90355,1,3,1,0)) Q:I<1  S X=^(I,0)
  1.  S BOPLSOC=$P(X,U,5),BOPDIV=$P(X,U)
  1.  S X="ERR^ZU",@^%ZOSF("TRAP"),ER=0
  1.  G GO^BOPRNEW
  1.  ;
  1. R(A,Z) ;Read the TCP/IP channel
  1.  ;This module returns X each time it is called
  1.  ;as a "line" of data (the text terminated by a $C(13)
  1.  ;
  1.  N BOPQ,Y
  1. RGO ;
  1.  ;First look in "buffer" for a segment
  1.  S Y=$F(BOPBUF,$C(13)),BOPQ=0
  1.  I 'Y S BOPQ=1
  1.  I Y S X=$E(BOPBUF,1,Y-2),BOPBUF=$E(BOPBUF,Y,9999) Q
  1.  ;
  1.  ;Since there was no discernable line in the buffer, read the channel
  1.  S X="ERR^BOPRNEW",@^%ZOSF("TRAP")
  1.  I $G(Z)["VAX" R X#200:$S($G(A):A,1:160)
  1.  ;Compliant with M standard
  1.  E  R X:$S(A:A,1:60)
  1.  ;
  1.  ;Add what was read to the buffer
  1.  I $L(X) S BOPBUF=BOPBUF_X
  1.  ;
  1.  ;If there was nothing in the buffer and nothing read then quit
  1.  I BOPQ,'$L(X),$L(BOPBUF) S X=BOPBUF,BOPBUF=""
  1.  I BOPBUF="",BOPQ Q
  1.  S BOPQ=0 G RGO:$L(BOPBUF)
  1.  Q
  1. TEST ;This is used for testing
  1. TSTGO ;
  1.  W $C(11)
  1.  W "MSH|^~\&|OMNICELLRX||PHARM||19940|260855||DFT^P03||P|2.2|",$C(13)
  1.  W "PID|||6|6|MAQQIA^ALAN|",$C(13)
  1.  W "PV1||NU4E^A22^Main2|",$C(13)
  1.  W "FT1||||199401260855||V|1217712^ASPIRIN^03||OR123|1||||||||||NID^NNAME|DR123",$C(13)
  1.  W "ZPM|V|OMNICELLRX|NUE100|3|A|12177121|ASPIRIN|U|112|112|1|NID|NNAME|WID|WNAME|222||Main2||NU4E||125|25|19940126085533||",$C(13)
  1.  W $C(28,13),!
  1.  H 9 R X:9
  1.  U 0
  1.  W !!,"Read from Channel (ACK?): "_X
  1.  W !!,"Don't forget to close the channel."
  1.  Q