BEEICTRL ; IHS/OIT/FJE - PROCESS INCOMING EIE MESSAGES ;
;;1.0;BEE;;Oct 19, 2009
;;
Q
TSK ; entry point for background job
D INIT
S U="^"
;change to queue node
S BEEIIEN=0 F S BEEIIEN=$O(^HLB(BEEIIEN)) Q:+BEEIIEN=0 D
.S BEEIX=$G(^HLB(BEEIIEN,0))
.Q:$P(BEEIX,U,4)'="I" ;If message is other than inbound
.Q:$L($P(BEEIX,U,20)) ;If present then message previously processed
.S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
.S U1=$E(BEEIMSH,4,4)
.S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF)
.S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA)
.Q:$P(BEEISF,U,1)'="Dental"
.Q:BEEISA'="DENTRIX"
.S BEEITYP=$P(BEEIMSH,U1,9)
.S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
.Q:'$L(BEEITYP)
.Q:'$L(BEEITRG)
.Q:BEEITYP'="DFT"
.Q:BEEITRG'="P03"
.S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)="HLO RPMS"
.S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)="CHARGE RPMS"
.;D @BEEIRUN
.S HLMSGIEN=BEEIIEN
.D PROC^BADEHL3
.S X="T+7" D ^%DT
.S $P(^HLB(BEEIIEN,0),U,9)=+Y_".1201"
.S $P(^HLB(BEEIIEN,0),U,20)="SU"
.S BEEITDT=$P(^HLB(BEEIIEN,0),U,16)
.I $L(BEEITDT) K ^HLB("QUEUE",BEEITDT,"RPMS-DEN",BEEITYP,BEEITRG,BEEIIEN)
D EXIT
Q
;future code
;L +^BEEICTRL:5 Q:'$T
;S BEEIQUET=0
;I '$D(^BEEICTRL("TASK RUNNING")) S ^BEEICTRL("TASK RUNNING")=$H
;S X1=$P($H,",",1)
;S Y1=$P($H,",",2)
;S X2=$P(^BEEICTRL("TASK RUNNING"),",",1)
;S Y2=$P(^BEEICTRL("TASK RUNNING"),",",2)
;I X1=X2&(Y1<(Y2+3600)) Q
;S ^BEEICTRL("TASK RUNNING")=$H
;D INIT ;INITIALIZE VARS
;D CTRL ;INITIALIZE ARRAY OF BEEI ENSEMBLE CONTROL FILE ENTRIES
;L -^BEEICTRL
;D SCAN ;SCAN HLB GLOBAL FOR NEW INBOUND MESSAGES TO BE PROCESSED
;K ^BEEICTRL("TASK RUNNING")
;D EXIT ;CLEAN UP AND QUIT
;Q
;
SINGLE ;
R !,"ENTER HLB IEN TO TEST: ",BEEIIEN:$G(DTIME)
Q:'+BEEIIEN
Q:'$D(^HLB(BEEIIEN,0))
Q:'$D(^HLB(BEEIIEN,1))
Q:'$D(^HLB(BEEIIEN,2))
D INIT
S U="^"
D
.S BEEIX=$G(^HLB(BEEIIEN,0))
.Q:$P(BEEIX,U,4)'="I" ;If message is other than inbound
.Q:$L($P(BEEIX,U,20)) ;If present then message previously processed
.S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
.S U1=$E(BEEIMSH,4,4)
.S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF)
.S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA)
.Q:BEEISF'="Dental"
.Q:BEEISA'="DENTRIX"
.S BEEITYP=$P(BEEIMSH,U1,9)
.S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
.Q:'$L(BEEITYP)
.Q:'$L(BEEITRG)
.Q:BEEITYP'="DFT"
.Q:BEEITRG'="P03"
.S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)="HLO RPMS"
.S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)="CHARGE RPMS"
.;D @BEEIRUN
.S HLMSGIEN=BEEIIEN
.D PROC^BADEHL3
.S X="T+7" D ^%DT
.S $P(^HLB(BEEIIEN,0),U,9)=+Y_".1201"
.S $P(^HLB(BEEIIEN,0),U,20)="SU"
.S BEEITDT=$P(^HLB(BEEIIEN,0),U,16)
.I $L(BEEITDT) K ^HLB("QUEUE",BEEITDT,"RPMS-DEN",BEEITYP,BEEITRG,BEEIIEN)
D EXIT
Q
;D INIT
D CTRL
S U="^"
S BEEIQUET=0
S HLMSGIEN=BEEIIEN
W !,"HLB LOOP ",BEEIIEN
S BEEIX=$G(^HLB(BEEIIEN,0))
Q:$P(BEEIX,U,4)'="I" ;If message is other than inbound
Q:+$P(BEEIX,U,20) ;If DATETIME present then message previously processed
I $G(BEEIQUET)'=1 W !,"Inbound Message: ",BEEIIEN
S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
S U1=$E(BEEIMSH,4,4)
S BEEIRF=$P(BEEIMSH,U1,5) Q:'$L(BEEIRF) Q:'$D(BEEITMP(BEEIRF))
S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF) Q:'$D(BEEITMP(BEEIRF,BEEISF))
S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA) Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA))
S BEEITYP=$P(BEEIMSH,U1,9)
S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
Q:'$L(BEEITYP) Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP))
Q:'$L(BEEITRG) Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG))
S BEEIY=0,BEEIY=$O(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)) Q:+BEEIY=0 D
.S BEEIRUN=BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)
.Q:$P(BEEIRUN,U,1)=""
.Q:$P(BEEIRUN,U,2)=""
.I $G(BEEIQUET)'=1 W !,BEEIRF_U1_BEEISF_U1_BEEISA_U1_BEEITYP_U1_BEEITRG_U1_BEEIY_U1_BEEIRUN,!!
.S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)=BEEICLNK
.S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)=BEEICQUE
.;S:$P(^HLB(BEEIIEN,0),U,7)="" $P(^HLB(BEEIIEN,0),U,7)=$P(BEEIRUN,U,1)
.;S:$P(^HLB(BEEIIEN,0),U,8)="" $P(^HLB(BEEIIEN,0),U,8)=$P(BEEIRUN,U,2)
.;S Y=$$REPR OC^HLOAPI3(BEEIIEN,.ERROR)
.D @BEEIRUN
.;I $G(BEEIQUET)'=1 W:Y=1 !,"Message processed successfully" H 2
.;I $G(BEEIQUET)'=1 W:Y=0 !,ERROR H 2
Q
;
INIT ;EP initialize variables
D ^XBKVAR
Q
;
CTRL ;EP create control array
S X=0 F S X=$O(^BEEICTRL(X)) Q:+X=0 D
.S BEEICACT=$P($G(^BEEICTRL(X,0)),U,2)
.S BEEICRF=$P($G(^BEEICTRL(X,0)),U,9)
.S BEEICSA=$P($G(^BEEICTRL(X,0)),U,4)
.S BEEICSF=$P($G(^BEEICTRL(X,0)),U,3)
.S BEEICTYP=$P($G(^BEEICTRL(X,0)),U,5)
.S BEEICTRG=$P($G(^BEEICTRL(X,0)),U,6)
.S BEEICTAG=$P($G(^BEEICTRL(X,0)),U,7)
.S BEEICRTN=$P($G(^BEEICTRL(X,0)),U,8)
.S BEEICLNK=$P($G(^BEEICTRL(X,0)),U,10)
.S BEEICQUE=$P($G(^BEEICTRL(X,2)),U,1)
.Q:BEEICACT'=1
.I (BEEICRF="")!(BEEICSA="")!(BEEICSF="")!(BEEICTYP="")!(BEEICTRG="") Q
.I (BEEICTAG="")!(BEEICRTN="")!(BEEICLNK="")!(BEEICQUE="") Q
.I '$D(BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)) D
..S BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)=BEEICTAG_"^"_BEEICRTN
..I $G(BEEIQUET)'=1 W !,BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)
Q
;
SCAN ;EP scan HLB global for new incoming messages
S U="^"
;change to queue node
S BEEIIEN=0 F S BEEIIEN=$O(^HLB(BEEIIEN)) Q:+BEEIIEN=0 D
.S BEEIX=$G(^HLB(BEEIIEN,0))
.Q:$P(BEEIX,U,4)'="I" ;If message is other than inbound
.Q:+$P(BEEIX,U,20) ;If DATETIME present then message previously processed
.I $G(BEEIQUET)'=1 W !,"Inbound Message: ",BEEIIEN
.S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
.S U1=$E(BEEIMSH,4,4)
.S BEEIRF=$P(BEEIMSH,U1,5) Q:'$L(BEEIRF) Q:'$D(BEEITMP(BEEIRF))
.S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF) Q:'$D(BEEITMP(BEEIRF,BEEISF))
.S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA) Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA))
.S BEEITYP=$P(BEEIMSH,U1,9)
.S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
.Q:'$L(BEEITYP) Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP))
.Q:'$L(BEEITRG) Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG))
.S BEEIY=0,BEEIY=$O(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)) Q:+BEEIY=0 D
..S BEEIRUN=BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)
..Q:$P(BEEIRUN,U,1)=""
..Q:$P(BEEIRUN,U,2)=""
..I $G(BEEIQUET)'=1 W !,BEEIRF_U1_BEEISF_U1_BEEISA_U1_BEEITYP_U1_BEEITRG_U1_BEEIY_U1_BEEIRUN
..S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)=BEEICLNK
..S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)=BEEICQUE
..;S:$P(^HLB(BEEIIEN,0),U,7)="" $P(^HLB(BEEIIEN,0),U,7)=$P(BEEIRUN,U,1)
..;S:$P(^HLB(BEEIIEN,0),U,8)="" $P(^HLB(BEEIIEN,0),U,8)=$P(BEEIRUN,U,2)
...D @BEEIRUN
..;I $G(BEEIQUET)'=1 W:Y=1 !,"Message processed successfully" H 2
..;I $G(BEEIQUET)'=1 W:Y=0 !,ERROR H 2
Q
;
EXIT ;EP clean up
D ^XBKVAR
K BEEITMP,BEEIX,BEEIY,BEEIRUN,BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG
K BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG
K ^BEEICTRL("TASK RUNNING")
Q
;
BEEICTRL ; IHS/OIT/FJE - PROCESS INCOMING EIE MESSAGES ;
+1 ;;1.0;BEE;;Oct 19, 2009
+2 ;;
+3 QUIT
TSK ; entry point for background job
+1 DO INIT
+2 SET U="^"
+3 ;change to queue node
+4 SET BEEIIEN=0
FOR
SET BEEIIEN=$ORDER(^HLB(BEEIIEN))
IF +BEEIIEN=0
QUIT
Begin DoDot:1
+5 SET BEEIX=$GET(^HLB(BEEIIEN,0))
+6 ;If message is other than inbound
IF $PIECE(BEEIX,U,4)'="I"
QUIT
+7 ;If present then message previously processed
IF $LENGTH($PIECE(BEEIX,U,20))
QUIT
+8 SET BEEIMSH=$GET(^HLB(BEEIIEN,1))_$GET(^HLB(BEEIIEN,2))
+9 SET U1=$EXTRACT(BEEIMSH,4,4)
+10 SET BEEISF=$PIECE(BEEIMSH,U1,4)
IF '$LENGTH(BEEISF)
QUIT
+11 SET BEEISA=$PIECE(BEEIMSH,U1,3)
IF '$LENGTH(BEEISA)
QUIT
+12 IF $PIECE(BEEISF,U,1)'="Dental"
QUIT
+13 IF BEEISA'="DENTRIX"
QUIT
+14 SET BEEITYP=$PIECE(BEEIMSH,U1,9)
+15 SET BEEITRG=$PIECE(BEEITYP,U,2)
SET BEEITYP=$PIECE(BEEITYP,U,1)
+16 IF '$LENGTH(BEEITYP)
QUIT
+17 IF '$LENGTH(BEEITRG)
QUIT
+18 IF BEEITYP'="DFT"
QUIT
+19 IF BEEITRG'="P03"
QUIT
+20 IF $PIECE(^HLB(BEEIIEN,0),U,5)=""
SET $PIECE(^HLB(BEEIIEN,0),U,5)="HLO RPMS"
+21 IF $PIECE(^HLB(BEEIIEN,0),U,6)=""
SET $PIECE(^HLB(BEEIIEN,0),U,6)="CHARGE RPMS"
+22 ;D @BEEIRUN
+23 SET HLMSGIEN=BEEIIEN
+24 DO PROC^BADEHL3
+25 SET X="T+7"
DO ^%DT
+26 SET $PIECE(^HLB(BEEIIEN,0),U,9)=+Y_".1201"
+27 SET $PIECE(^HLB(BEEIIEN,0),U,20)="SU"
+28 SET BEEITDT=$PIECE(^HLB(BEEIIEN,0),U,16)
+29 IF $LENGTH(BEEITDT)
KILL ^HLB("QUEUE",BEEITDT,"RPMS-DEN",BEEITYP,BEEITRG,BEEIIEN)
End DoDot:1
+30 DO EXIT
+31 QUIT
+32 ;future code
+33 ;L +^BEEICTRL:5 Q:'$T
+34 ;S BEEIQUET=0
+35 ;I '$D(^BEEICTRL("TASK RUNNING")) S ^BEEICTRL("TASK RUNNING")=$H
+36 ;S X1=$P($H,",",1)
+37 ;S Y1=$P($H,",",2)
+38 ;S X2=$P(^BEEICTRL("TASK RUNNING"),",",1)
+39 ;S Y2=$P(^BEEICTRL("TASK RUNNING"),",",2)
+40 ;I X1=X2&(Y1<(Y2+3600)) Q
+41 ;S ^BEEICTRL("TASK RUNNING")=$H
+42 ;D INIT ;INITIALIZE VARS
+43 ;D CTRL ;INITIALIZE ARRAY OF BEEI ENSEMBLE CONTROL FILE ENTRIES
+44 ;L -^BEEICTRL
+45 ;D SCAN ;SCAN HLB GLOBAL FOR NEW INBOUND MESSAGES TO BE PROCESSED
+46 ;K ^BEEICTRL("TASK RUNNING")
+47 ;D EXIT ;CLEAN UP AND QUIT
+48 ;Q
+49 ;
SINGLE ;
+1 READ !,"ENTER HLB IEN TO TEST: ",BEEIIEN:$GET(DTIME)
+2 IF '+BEEIIEN
QUIT
+3 IF '$DATA(^HLB(BEEIIEN,0))
QUIT
+4 IF '$DATA(^HLB(BEEIIEN,1))
QUIT
+5 IF '$DATA(^HLB(BEEIIEN,2))
QUIT
+6 DO INIT
+7 SET U="^"
+8 Begin DoDot:1
+9 SET BEEIX=$GET(^HLB(BEEIIEN,0))
+10 ;If message is other than inbound
IF $PIECE(BEEIX,U,4)'="I"
QUIT
+11 ;If present then message previously processed
IF $LENGTH($PIECE(BEEIX,U,20))
QUIT
+12 SET BEEIMSH=$GET(^HLB(BEEIIEN,1))_$GET(^HLB(BEEIIEN,2))
+13 SET U1=$EXTRACT(BEEIMSH,4,4)
+14 SET BEEISF=$PIECE(BEEIMSH,U1,4)
IF '$LENGTH(BEEISF)
QUIT
+15 SET BEEISA=$PIECE(BEEIMSH,U1,3)
IF '$LENGTH(BEEISA)
QUIT
+16 IF BEEISF'="Dental"
QUIT
+17 IF BEEISA'="DENTRIX"
QUIT
+18 SET BEEITYP=$PIECE(BEEIMSH,U1,9)
+19 SET BEEITRG=$PIECE(BEEITYP,U,2)
SET BEEITYP=$PIECE(BEEITYP,U,1)
+20 IF '$LENGTH(BEEITYP)
QUIT
+21 IF '$LENGTH(BEEITRG)
QUIT
+22 IF BEEITYP'="DFT"
QUIT
+23 IF BEEITRG'="P03"
QUIT
+24 IF $PIECE(^HLB(BEEIIEN,0),U,5)=""
SET $PIECE(^HLB(BEEIIEN,0),U,5)="HLO RPMS"
+25 IF $PIECE(^HLB(BEEIIEN,0),U,6)=""
SET $PIECE(^HLB(BEEIIEN,0),U,6)="CHARGE RPMS"
+26 ;D @BEEIRUN
+27 SET HLMSGIEN=BEEIIEN
+28 DO PROC^BADEHL3
+29 SET X="T+7"
DO ^%DT
+30 SET $PIECE(^HLB(BEEIIEN,0),U,9)=+Y_".1201"
+31 SET $PIECE(^HLB(BEEIIEN,0),U,20)="SU"
+32 SET BEEITDT=$PIECE(^HLB(BEEIIEN,0),U,16)
+33 IF $LENGTH(BEEITDT)
KILL ^HLB("QUEUE",BEEITDT,"RPMS-DEN",BEEITYP,BEEITRG,BEEIIEN)
End DoDot:1
+34 DO EXIT
+35 QUIT
+36 ;D INIT
+37 DO CTRL
+38 SET U="^"
+39 SET BEEIQUET=0
+40 SET HLMSGIEN=BEEIIEN
+41 WRITE !,"HLB LOOP ",BEEIIEN
+42 SET BEEIX=$GET(^HLB(BEEIIEN,0))
+43 ;If message is other than inbound
IF $PIECE(BEEIX,U,4)'="I"
QUIT
+44 ;If DATETIME present then message previously processed
IF +$PIECE(BEEIX,U,20)
QUIT
+45 IF $GET(BEEIQUET)'=1
WRITE !,"Inbound Message: ",BEEIIEN
+46 SET BEEIMSH=$GET(^HLB(BEEIIEN,1))_$GET(^HLB(BEEIIEN,2))
+47 SET U1=$EXTRACT(BEEIMSH,4,4)
+48 SET BEEIRF=$PIECE(BEEIMSH,U1,5)
IF '$LENGTH(BEEIRF)
QUIT
IF '$DATA(BEEITMP(BEEIRF))
QUIT
+49 SET BEEISF=$PIECE(BEEIMSH,U1,4)
IF '$LENGTH(BEEISF)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF))
QUIT
+50 SET BEEISA=$PIECE(BEEIMSH,U1,3)
IF '$LENGTH(BEEISA)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF,BEEISA))
QUIT
+51 SET BEEITYP=$PIECE(BEEIMSH,U1,9)
+52 SET BEEITRG=$PIECE(BEEITYP,U,2)
SET BEEITYP=$PIECE(BEEITYP,U,1)
+53 IF '$LENGTH(BEEITYP)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP))
QUIT
+54 IF '$LENGTH(BEEITRG)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG))
QUIT
+55 SET BEEIY=0
SET BEEIY=$ORDER(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY))
IF +BEEIY=0
QUIT
Begin DoDot:1
+56 SET BEEIRUN=BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)
+57 IF $PIECE(BEEIRUN,U,1)=""
QUIT
+58 IF $PIECE(BEEIRUN,U,2)=""
QUIT
+59 IF $GET(BEEIQUET)'=1
WRITE !,BEEIRF_U1_BEEISF_U1_BEEISA_U1_BEEITYP_U1_BEEITRG_U1_BEEIY_U1_BEEIRUN,!!
+60 IF $PIECE(^HLB(BEEIIEN,0),U,5)=""
SET $PIECE(^HLB(BEEIIEN,0),U,5)=BEEICLNK
+61 IF $PIECE(^HLB(BEEIIEN,0),U,6)=""
SET $PIECE(^HLB(BEEIIEN,0),U,6)=BEEICQUE
+62 ;S:$P(^HLB(BEEIIEN,0),U,7)="" $P(^HLB(BEEIIEN,0),U,7)=$P(BEEIRUN,U,1)
+63 ;S:$P(^HLB(BEEIIEN,0),U,8)="" $P(^HLB(BEEIIEN,0),U,8)=$P(BEEIRUN,U,2)
+64 ;S Y=$$REPR OC^HLOAPI3(BEEIIEN,.ERROR)
+65 DO @BEEIRUN
+66 ;I $G(BEEIQUET)'=1 W:Y=1 !,"Message processed successfully" H 2
+67 ;I $G(BEEIQUET)'=1 W:Y=0 !,ERROR H 2
End DoDot:1
+68 QUIT
+69 ;
INIT ;EP initialize variables
+1 DO ^XBKVAR
+2 QUIT
+3 ;
CTRL ;EP create control array
+1 SET X=0
FOR
SET X=$ORDER(^BEEICTRL(X))
IF +X=0
QUIT
Begin DoDot:1
+2 SET BEEICACT=$PIECE($GET(^BEEICTRL(X,0)),U,2)
+3 SET BEEICRF=$PIECE($GET(^BEEICTRL(X,0)),U,9)
+4 SET BEEICSA=$PIECE($GET(^BEEICTRL(X,0)),U,4)
+5 SET BEEICSF=$PIECE($GET(^BEEICTRL(X,0)),U,3)
+6 SET BEEICTYP=$PIECE($GET(^BEEICTRL(X,0)),U,5)
+7 SET BEEICTRG=$PIECE($GET(^BEEICTRL(X,0)),U,6)
+8 SET BEEICTAG=$PIECE($GET(^BEEICTRL(X,0)),U,7)
+9 SET BEEICRTN=$PIECE($GET(^BEEICTRL(X,0)),U,8)
+10 SET BEEICLNK=$PIECE($GET(^BEEICTRL(X,0)),U,10)
+11 SET BEEICQUE=$PIECE($GET(^BEEICTRL(X,2)),U,1)
+12 IF BEEICACT'=1
QUIT
+13 IF (BEEICRF="")!(BEEICSA="")!(BEEICSF="")!(BEEICTYP="")!(BEEICTRG="")
QUIT
+14 IF (BEEICTAG="")!(BEEICRTN="")!(BEEICLNK="")!(BEEICQUE="")
QUIT
+15 IF '$DATA(BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X))
Begin DoDot:2
+16 SET BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)=BEEICTAG_"^"_BEEICRTN
+17 IF $GET(BEEIQUET)'=1
WRITE !,BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
SCAN ;EP scan HLB global for new incoming messages
+1 SET U="^"
+2 ;change to queue node
+3 SET BEEIIEN=0
FOR
SET BEEIIEN=$ORDER(^HLB(BEEIIEN))
IF +BEEIIEN=0
QUIT
Begin DoDot:1
+4 SET BEEIX=$GET(^HLB(BEEIIEN,0))
+5 ;If message is other than inbound
IF $PIECE(BEEIX,U,4)'="I"
QUIT
+6 ;If DATETIME present then message previously processed
IF +$PIECE(BEEIX,U,20)
QUIT
+7 IF $GET(BEEIQUET)'=1
WRITE !,"Inbound Message: ",BEEIIEN
+8 SET BEEIMSH=$GET(^HLB(BEEIIEN,1))_$GET(^HLB(BEEIIEN,2))
+9 SET U1=$EXTRACT(BEEIMSH,4,4)
+10 SET BEEIRF=$PIECE(BEEIMSH,U1,5)
IF '$LENGTH(BEEIRF)
QUIT
IF '$DATA(BEEITMP(BEEIRF))
QUIT
+11 SET BEEISF=$PIECE(BEEIMSH,U1,4)
IF '$LENGTH(BEEISF)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF))
QUIT
+12 SET BEEISA=$PIECE(BEEIMSH,U1,3)
IF '$LENGTH(BEEISA)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF,BEEISA))
QUIT
+13 SET BEEITYP=$PIECE(BEEIMSH,U1,9)
+14 SET BEEITRG=$PIECE(BEEITYP,U,2)
SET BEEITYP=$PIECE(BEEITYP,U,1)
+15 IF '$LENGTH(BEEITYP)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP))
QUIT
+16 IF '$LENGTH(BEEITRG)
QUIT
IF '$DATA(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG))
QUIT
+17 SET BEEIY=0
SET BEEIY=$ORDER(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY))
IF +BEEIY=0
QUIT
Begin DoDot:2
+18 SET BEEIRUN=BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)
+19 IF $PIECE(BEEIRUN,U,1)=""
QUIT
+20 IF $PIECE(BEEIRUN,U,2)=""
QUIT
+21 IF $GET(BEEIQUET)'=1
WRITE !,BEEIRF_U1_BEEISF_U1_BEEISA_U1_BEEITYP_U1_BEEITRG_U1_BEEIY_U1_BEEIRUN
+22 IF $PIECE(^HLB(BEEIIEN,0),U,5)=""
SET $PIECE(^HLB(BEEIIEN,0),U,5)=BEEICLNK
+23 IF $PIECE(^HLB(BEEIIEN,0),U,6)=""
SET $PIECE(^HLB(BEEIIEN,0),U,6)=BEEICQUE
+24 ;S:$P(^HLB(BEEIIEN,0),U,7)="" $P(^HLB(BEEIIEN,0),U,7)=$P(BEEIRUN,U,1)
+25 ;S:$P(^HLB(BEEIIEN,0),U,8)="" $P(^HLB(BEEIIEN,0),U,8)=$P(BEEIRUN,U,2)
+26 DO @BEEIRUN
+27 ;I $G(BEEIQUET)'=1 W:Y=1 !,"Message processed successfully" H 2
+28 ;I $G(BEEIQUET)'=1 W:Y=0 !,ERROR H 2
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
EXIT ;EP clean up
+1 DO ^XBKVAR
+2 KILL BEEITMP,BEEIX,BEEIY,BEEIRUN,BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG
+3 KILL BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG
+4 KILL ^BEEICTRL("TASK RUNNING")
+5 QUIT
+6 ;
