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

BEEICTRL.m

Go to the documentation of this file. 
  1. BEEICTRL ; IHS/OIT/FJE - PROCESS INCOMING EIE MESSAGES ;
  1.  ;;1.0;BEE;;Oct 19, 2009
  1.  ;;
  1.  Q
  1. TSK ; entry point for background job
  1.  D INIT
  1.  S U="^"
  1.  ;change to queue node
  1.  S BEEIIEN=0 F  S BEEIIEN=$O(^HLB(BEEIIEN)) Q:+BEEIIEN=0  D
  1.  .S BEEIX=$G(^HLB(BEEIIEN,0))
  1.  .Q:$P(BEEIX,U,4)'="I"  ;If message is other than inbound
  1.  .Q:$L($P(BEEIX,U,20))  ;If present then message previously processed
  1.  .S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
  1.  .S U1=$E(BEEIMSH,4,4)
  1.  .S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF)
  1.  .S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA)
  1.  .Q:$P(BEEISF,U,1)'="Dental"
  1.  .Q:BEEISA'="DENTRIX"
  1.  .S BEEITYP=$P(BEEIMSH,U1,9)
  1.  .S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
  1.  .Q:'$L(BEEITYP)
  1.  .Q:'$L(BEEITRG)
  1.  .Q:BEEITYP'="DFT"
  1.  .Q:BEEITRG'="P03"
  1.  .S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)="HLO RPMS"
  1.  .S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)="CHARGE RPMS"
  1.  .;D @BEEIRUN
  1.  .S HLMSGIEN=BEEIIEN
  1.  .D PROC^BADEHL3
  1.  .S X="T+7" D ^%DT
  1.  .S $P(^HLB(BEEIIEN,0),U,9)=+Y_".1201"
  1.  .S $P(^HLB(BEEIIEN,0),U,20)="SU"
  1.  .S BEEITDT=$P(^HLB(BEEIIEN,0),U,16)
  1.  .I $L(BEEITDT) K ^HLB("QUEUE",BEEITDT,"RPMS-DEN",BEEITYP,BEEITRG,BEEIIEN)
  1.  D EXIT
  1.  Q
  1.  ;future code
  1.  ;L +^BEEICTRL:5 Q:'$T
  1.  ;S BEEIQUET=0
  1.  ;I '$D(^BEEICTRL("TASK RUNNING")) S ^BEEICTRL("TASK RUNNING")=$H
  1.  ;S X1=$P($H,",",1)
  1.  ;S Y1=$P($H,",",2)
  1.  ;S X2=$P(^BEEICTRL("TASK RUNNING"),",",1)
  1.  ;S Y2=$P(^BEEICTRL("TASK RUNNING"),",",2)
  1.  ;I X1=X2&(Y1<(Y2+3600)) Q
  1.  ;S ^BEEICTRL("TASK RUNNING")=$H
  1.  ;D INIT    ;INITIALIZE VARS
  1.  ;D CTRL    ;INITIALIZE ARRAY OF BEEI ENSEMBLE CONTROL FILE ENTRIES
  1.  ;L -^BEEICTRL
  1.  ;D SCAN    ;SCAN HLB GLOBAL FOR NEW INBOUND MESSAGES TO BE PROCESSED
  1.  ;K ^BEEICTRL("TASK RUNNING")
  1.  ;D EXIT    ;CLEAN UP AND QUIT
  1.  ;Q
  1.  ;
  1. SINGLE ;
  1.  R !,"ENTER HLB IEN TO TEST:  ",BEEIIEN:$G(DTIME)
  1.  Q:'+BEEIIEN
  1.  Q:'$D(^HLB(BEEIIEN,0))
  1.  Q:'$D(^HLB(BEEIIEN,1))
  1.  Q:'$D(^HLB(BEEIIEN,2))
  1.  D INIT
  1.  S U="^"
  1.  D
  1.  .S BEEIX=$G(^HLB(BEEIIEN,0))
  1.  .Q:$P(BEEIX,U,4)'="I"  ;If message is other than inbound
  1.  .Q:$L($P(BEEIX,U,20))  ;If present then message previously processed
  1.  .S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
  1.  .S U1=$E(BEEIMSH,4,4)
  1.  .S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF)
  1.  .S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA)
  1.  .Q:BEEISF'="Dental"
  1.  .Q:BEEISA'="DENTRIX"
  1.  .S BEEITYP=$P(BEEIMSH,U1,9)
  1.  .S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
  1.  .Q:'$L(BEEITYP)
  1.  .Q:'$L(BEEITRG)
  1.  .Q:BEEITYP'="DFT"
  1.  .Q:BEEITRG'="P03"
  1.  .S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)="HLO RPMS"
  1.  .S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)="CHARGE RPMS"
  1.  .;D @BEEIRUN
  1.  .S HLMSGIEN=BEEIIEN
  1.  .D PROC^BADEHL3
  1.  .S X="T+7" D ^%DT
  1.  .S $P(^HLB(BEEIIEN,0),U,9)=+Y_".1201"
  1.  .S $P(^HLB(BEEIIEN,0),U,20)="SU"
  1.  .S BEEITDT=$P(^HLB(BEEIIEN,0),U,16)
  1.  .I $L(BEEITDT) K ^HLB("QUEUE",BEEITDT,"RPMS-DEN",BEEITYP,BEEITRG,BEEIIEN)
  1.  D EXIT
  1.  Q
  1.  ;D INIT
  1.  D CTRL
  1.  S U="^"
  1.  S BEEIQUET=0
  1.  S HLMSGIEN=BEEIIEN
  1.  W !,"HLB LOOP  ",BEEIIEN
  1.  S BEEIX=$G(^HLB(BEEIIEN,0))
  1.  Q:$P(BEEIX,U,4)'="I"  ;If message is other than inbound
  1.  Q:+$P(BEEIX,U,20)  ;If DATETIME present then message previously processed
  1.  I $G(BEEIQUET)'=1 W !,"Inbound Message:  ",BEEIIEN
  1.  S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
  1.  S U1=$E(BEEIMSH,4,4)
  1.  S BEEIRF=$P(BEEIMSH,U1,5) Q:'$L(BEEIRF)  Q:'$D(BEEITMP(BEEIRF))
  1.  S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF)  Q:'$D(BEEITMP(BEEIRF,BEEISF))
  1.  S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA)  Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA))
  1.  S BEEITYP=$P(BEEIMSH,U1,9)
  1.  S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
  1.  Q:'$L(BEEITYP)  Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP))
  1.  Q:'$L(BEEITRG)  Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG))
  1.  S BEEIY=0,BEEIY=$O(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)) Q:+BEEIY=0  D
  1.  .S BEEIRUN=BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)
  1.  .Q:$P(BEEIRUN,U,1)=""
  1.  .Q:$P(BEEIRUN,U,2)=""
  1.  .I $G(BEEIQUET)'=1 W !,BEEIRF_U1_BEEISF_U1_BEEISA_U1_BEEITYP_U1_BEEITRG_U1_BEEIY_U1_BEEIRUN,!!
  1.  .S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)=BEEICLNK
  1.  .S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)=BEEICQUE
  1.  .;S:$P(^HLB(BEEIIEN,0),U,7)="" $P(^HLB(BEEIIEN,0),U,7)=$P(BEEIRUN,U,1)
  1.  .;S:$P(^HLB(BEEIIEN,0),U,8)="" $P(^HLB(BEEIIEN,0),U,8)=$P(BEEIRUN,U,2)
  1.  .;S Y=$$REPR OC^HLOAPI3(BEEIIEN,.ERROR)
  1.  .D @BEEIRUN
  1.  .;I $G(BEEIQUET)'=1 W:Y=1 !,"Message processed successfully" H 2
  1.  .;I $G(BEEIQUET)'=1 W:Y=0 !,ERROR H 2
  1.  Q
  1.  ;
  1. INIT  ;EP initialize variables
  1.  D ^XBKVAR
  1.  Q
  1.  ;
  1. CTRL  ;EP create control array  
  1.   S X=0 F  S X=$O(^BEEICTRL(X)) Q:+X=0  D
  1.  .S BEEICACT=$P($G(^BEEICTRL(X,0)),U,2)
  1.  .S BEEICRF=$P($G(^BEEICTRL(X,0)),U,9)
  1.  .S BEEICSA=$P($G(^BEEICTRL(X,0)),U,4)
  1.  .S BEEICSF=$P($G(^BEEICTRL(X,0)),U,3)
  1.  .S BEEICTYP=$P($G(^BEEICTRL(X,0)),U,5)
  1.  .S BEEICTRG=$P($G(^BEEICTRL(X,0)),U,6)
  1.  .S BEEICTAG=$P($G(^BEEICTRL(X,0)),U,7)
  1.  .S BEEICRTN=$P($G(^BEEICTRL(X,0)),U,8)
  1.  .S BEEICLNK=$P($G(^BEEICTRL(X,0)),U,10)
  1.  .S BEEICQUE=$P($G(^BEEICTRL(X,2)),U,1)
  1.  .Q:BEEICACT'=1
  1.  .I (BEEICRF="")!(BEEICSA="")!(BEEICSF="")!(BEEICTYP="")!(BEEICTRG="") Q
  1.  .I (BEEICTAG="")!(BEEICRTN="")!(BEEICLNK="")!(BEEICQUE="") Q
  1.  .I '$D(BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)) D
  1.  ..S BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)=BEEICTAG_"^"_BEEICRTN
  1.  ..I $G(BEEIQUET)'=1 W !,BEEITMP(BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG,X)
  1.  Q
  1.  ;
  1. SCAN  ;EP scan HLB global for new incoming messages
  1.  S U="^"
  1.  ;change to queue node
  1.  S BEEIIEN=0 F  S BEEIIEN=$O(^HLB(BEEIIEN)) Q:+BEEIIEN=0  D
  1.  .S BEEIX=$G(^HLB(BEEIIEN,0))
  1.  .Q:$P(BEEIX,U,4)'="I"  ;If message is other than inbound
  1.  .Q:+$P(BEEIX,U,20)  ;If DATETIME present then message previously processed
  1.  .I $G(BEEIQUET)'=1 W !,"Inbound Message:  ",BEEIIEN
  1.  .S BEEIMSH=$G(^HLB(BEEIIEN,1))_$G(^HLB(BEEIIEN,2))
  1.  .S U1=$E(BEEIMSH,4,4)
  1.  .S BEEIRF=$P(BEEIMSH,U1,5) Q:'$L(BEEIRF)  Q:'$D(BEEITMP(BEEIRF))
  1.  .S BEEISF=$P(BEEIMSH,U1,4) Q:'$L(BEEISF)  Q:'$D(BEEITMP(BEEIRF,BEEISF))
  1.  .S BEEISA=$P(BEEIMSH,U1,3) Q:'$L(BEEISA)  Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA))
  1.  .S BEEITYP=$P(BEEIMSH,U1,9)
  1.  .S BEEITRG=$P(BEEITYP,U,2),BEEITYP=$P(BEEITYP,U,1)
  1.  .Q:'$L(BEEITYP)  Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP))
  1.  .Q:'$L(BEEITRG)  Q:'$D(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG))
  1.  .S BEEIY=0,BEEIY=$O(BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)) Q:+BEEIY=0  D
  1.  ..S BEEIRUN=BEEITMP(BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG,BEEIY)
  1.  ..Q:$P(BEEIRUN,U,1)=""
  1.  ..Q:$P(BEEIRUN,U,2)=""
  1.  ..I $G(BEEIQUET)'=1 W !,BEEIRF_U1_BEEISF_U1_BEEISA_U1_BEEITYP_U1_BEEITRG_U1_BEEIY_U1_BEEIRUN
  1.  ..S:$P(^HLB(BEEIIEN,0),U,5)="" $P(^HLB(BEEIIEN,0),U,5)=BEEICLNK
  1.  ..S:$P(^HLB(BEEIIEN,0),U,6)="" $P(^HLB(BEEIIEN,0),U,6)=BEEICQUE
  1.  ..;S:$P(^HLB(BEEIIEN,0),U,7)="" $P(^HLB(BEEIIEN,0),U,7)=$P(BEEIRUN,U,1)
  1.  ..;S:$P(^HLB(BEEIIEN,0),U,8)="" $P(^HLB(BEEIIEN,0),U,8)=$P(BEEIRUN,U,2)
  1.  ...D @BEEIRUN
  1.  ..;I $G(BEEIQUET)'=1 W:Y=1 !,"Message processed successfully" H 2
  1.  ..;I $G(BEEIQUET)'=1 W:Y=0 !,ERROR H 2
  1.  Q
  1.  ;
  1. EXIT  ;EP clean up
  1.  D ^XBKVAR
  1.  K BEEITMP,BEEIX,BEEIY,BEEIRUN,BEEIRF,BEEISF,BEEISA,BEEITYP,BEEITRG
  1.  K BEEICRF,BEEICSF,BEEICSA,BEEICTYP,BEEICTRG
  1.  K ^BEEICTRL("TASK RUNNING")
  1.  Q
  1.  ;