BGPGUA ; IHS/CMI/LAB - BGP Gui Utilities 03/11/2010 3:28:39 PM ; 16 Oct 2014 12:11 PM
;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
;
DEBUG(RETVAL,BGPSTR) ;run the debugger
D DEBUG^%Serenji("SEARCH^BGPGUA(.RETVAL,.BGPSTR)")
Q
;
ADO ;EP -- setup the ADO string for each call
S BGPX="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
Q
;
SEARCH(RETVAL,BGPSTR) ;-- return search results to Search
N BGPDA,BGPI,P,BGPFL,BGPIDX,BGPGB,BGPS,BGPSZ,BGPL,BGPTGT,BGPFLDS,BGPSCR,BGPPR,BGPFLD1,BGPFLD2,BGPDT
S P="|"
S BGPI=0
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
S RETVAL="^BGPTMP("_$J_")"
K ^BGPTMP($J)
K ^BGPTMPD($J)
S BGPTGT="^BGPTMPD("_$J_")" ;target for find^dic lookup
S BGPFL=$P(BGPSTR,P)
I $E(BGPFL,1,1)=0 S BGPFL=+BGPFL
S BGPIDX=$P(BGPSTR,P,2)
I BGPIDX]"" S BGPIDX=$TR(BGPIDX,"*","^")
S BGPS=$P(BGPSTR,P,3)
I BGPFL=9002012.2,BGPS="" S BGPIDX="BA"
S BGPFLD1=$P(BGPSTR,P,4)
S BGPFLD2=$P(BGPSTR,P,5)
S BGPSCR=$P(BGPSTR,P,6)
S BGPDT=$P(BGPSTR,P,8)
I $G(BGPSCR)["" S BGPSCR=$TR(BGPSCR,"*","^")
S BGPPR=$P(BGPSTR,P,7)
S BGPDT=$P(BGPSTR,P,8)
I BGPFLD1["." S BGPFLD1=+BGPFLD1
I BGPFLD2["." S BGPFLD2=+BGPFLD2
I BGPFLD2=0 S BGPFLD2=""
S BGPFLDS=$S(BGPFLD2]"":BGPFLD1_";"_BGPFLD2,1:BGPFLD1)
I BGPS="" D
. D LIST^DIC(BGPFL,"",BGPFLDS,"","","",BGPS,BGPIDX,BGPSCR,"",BGPTGT,"BGPERRR(1)")
I BGPS]"" D
. D FIND^DIC(BGPFL,"",BGPFLDS,"",BGPS,"",BGPIDX,BGPSCR,"",BGPTGT,"BGPERRR(1)")
S @RETVAL@(0)="T00010BMXIEN^T00050Value1^T00080Value2"_$C(30)
S BGPDA=0 F S BGPDA=$O(@BGPTGT@("DILIST","ID",BGPDA)) Q:'BGPDA D
. N BGPIEN,BGPBMX
. S BGPIEN=0 F S BGPIEN=$O(@BGPTGT@("DILIST","ID",BGPDA,BGPIEN)) Q:'BGPIEN D
.. S BGPBMX=$G(@BGPTGT@("DILIST",2,BGPDA))
.. S BGPFLD(BGPIEN)=$G(@BGPTGT@("DILIST","ID",BGPDA,BGPIEN))
. Q:'$G(BGPBMX)
. S BGPI=BGPI+1
. S @RETVAL@(BGPI)=BGPBMX_U_BGPFLD(BGPFLD1)_U_$S($G(BGPFLD2):$G(BGPFLD(BGPFLD2)),1:"")_$C(30)
S @RETVAL@(BGPI+1)=$C(31)
Q
;
TIME(RETVAL,BGPSTR) ;-- get system time out based on user or location
N P,BGPDUZ,BGPDUZ2,BGPI,BGPVAL,BGPVALI
S P="|"
S BGPDUZ=$P(BGPSTR,P)
S BGPDUZ2=$P(BGPSTR,P,2)
S BGPI=0
S RETVAL="^BGPTMP("_$J_")"
K ^BGPTMP($J)
S @RETVAL@(BGPI)="T00010TimeOut"_$C(30)
S BGPVAL=$$GET1^DIQ(200,BGPDUZ,200.1)
I '$G(BGPVAL) D
. S BGPVAL=$$GET1^DIQ(8989.3,1,210)
S BGPI=BGPI+1
S @RETVAL@(BGPI)=$G(BGPVAL)_$C(30)
S @RETVAL@(BGPI+1)=$C(31)
Q
;
AUTO(RETVAL,BGPSTR) ;-- save the automated gpra parameters
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,P,BGPLOC,BGPTAX,BGPTYP,BGPDIR,BGPIP,BGPUSER,BGPPASS,BGPQUEUE,BGPRET,BGPTASK
S P="|"
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S BGPLOC=$P(BGPSTR,P)
S BGPTAX=$P(BGPSTR,P,2)
S BGPTYP=$P(BGPSTR,P,3)
S BGPDIR=$P(BGPSTR,P,4)
S BGPIP=$P(BGPSTR,P,5)
S BGPUSER=$P(BGPSTR,P,6)
S BGPPASS=$P(BGPSTR,P,7)
S BGPQUEUE=$P(BGPSTR,P,8)
S BGPI=0
I '$O(^BGPGP2PM("B",BGPLOC,0)) D
. N BGPFDA,BGPIENS,BGPERR
. S BGPIENS(1)=BGPLOC
. S BGPFDA(90241.04,"+1,",.01)=BGPLOC
. S BGPFDA(90241.04,"+1,",.02)=BGPTYP
. S BGPFDA(90241.04,"+1,",4.2)=BGPIP
. S BGPFDA(90241.04,"+1,",4.3)=BGPDIR
. S BGPFDA(90241.04,"+1,",4.4)=BGPUSER
. S BGPFDA(90241.04,"+1,",4.5)=BGPPASS
. S BGPFDA(90241.04,"+1,",5.1)=BGPTAX
. D UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
. S BGPRET=$G(BGPIENS(1))
I $O(^BGPGP2PM("B",BGPLOC,0)) D
. N BGPFDA,BGPIENS,BGPERR
. S BGPIENS=$O(^BGPGP2PM("B",BGPLOC,0))_","
. S BGPFDA(90241.04,BGPIENS,.02)=BGPTYP
. S BGPFDA(90241.04,BGPIENS,4.2)=BGPIP
. S BGPFDA(90241.04,BGPIENS,4.3)=BGPDIR
. S BGPFDA(90241.04,BGPIENS,4.4)=BGPUSER
. S BGPFDA(90241.04,BGPIENS,4.5)=BGPPASS
. S BGPFDA(90241.04,BGPIENS,5.1)=BGPTAX
. D FILE^DIE("K","BGPFDA","BGPERR(1)")
. S BGPRET=$G(BGPIENS(1))
I $G(BGPQUEUE) D
. S BGPTASK=$$CHKFQT^BGP3AUEX(BGPLOC) ;check for currently queued task
. I BGPTASK D Q
.. S ZTSK=BGPTASK
.. D KILL^%ZTLOAD
. D SCHEDGUI^BGP3AUEX
S RETVAL="^BGPTMP("_$J_")"
K ^BGPTMP($J)
S @RETVAL@(BGPI)="T00001Return"_$C(30)
S BGPI=BGPI+1
S @RETVAL@(BGPI)=$S($G(BGPRET)]"":BGPRET,$G(BGPTASK):BGPTASK,1:"")_$C(30)
S @RETVAL@(BGPI+1)=$C(31)
Q
;
AUTOA(RETVAL,BGPSTR) ;-- save the area automated gpra parameters
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,P,BGPNAM,BGPTYP,BGPDIR,BGPSDIR,BGPALERT,BGPFAC,BGPREC,BGPQUEUE,BGPRUN,BGPRET,BGPTASK,BGPFACI,BGPRECI
S P="|"
I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
S BGPNAM=$P(BGPSTR,P)
S BGPTYP=$P(BGPSTR,P,2)
S BGPDIR=$P(BGPSTR,P,3)
S BGPSDIR=$P(BGPSTR,P,4)
S BGPALERT=$P(BGPSTR,P,5)
S BGPQUEUE=$P(BGPSTR,P,6)
S BGPRUN=$P(BGPSTR,P,7)
S BGPFAC=$P(BGPSTR,P,8)
S BGPREC=$P(BGPSTR,P,9)
I '$O(^BGPGP1PM("B",BGPNAM,0)) D
. N BGPFDA,BGPIENS,BGPERR
. S BGPIENS="+1,"
. S BGPFDA(90245,"+1,",.01)=BGPNAM
. S BGPFDA(90245,"+1,",.02)=BGPTYP
. S BGPFDA(90245,"+1,",1.1)=BGPDIR
. S BGPFDA(90245,"+1,",1.2)=BGPSDIR
. S BGPFDA(90245,"+1,",99.1)=BGPALERT
. D UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
. S BGPRET=$G(BGPIENS(1))
I $O(^BGPGP1PM("B",BGPNAM,0)) D
. N BGPFDA,BGPIENS,BGPERR
. S BGPIENS=$O(^BGPGP1PM("B",BGPNAM,0))_","
. S BGPFDA(90245,BGPIENS,.02)=BGPTYP
. S BGPFDA(90245,BGPIENS,1.1)=BGPDIR
. S BGPFDA(90245,BGPIENS,1.2)=BGPSDIR
. S BGPFDA(90245,BGPIENS,99.1)=BGPALERT
. D FILE^DIE("K","BGPFDA","BGPERR(1)")
. S BGPRET=$G(BGPIENS(1))
S BGPIEN=$O(^BGPGP1PM("B",BGPNAM,0))
D CLNFAC(BGPIEN),CLNREC(BGPIEN)
F I=1:1 D Q:'BGPFACI
. N BGPTDA,BGPTERR,BGPTIENS
. S BGPFACI=$P($P(BGPFAC,"*",I),"~",1)
. Q:'BGPFACI
. S BGPTIENS="+2,"_BGPIEN_","
. S BGPTDA(90245.09,BGPTIENS,.01)=BGPFACI
. S BGPTDA(90245.09,BGPTIENS,.02)=$$GET1^DIQ(9999999.06,BGPFACI,.12)
. S BGPTDA(90245.09,BGPTIENS,.03)=1
. D UPDATE^DIE("","BGPTDA","BGPTIENS","BGPTERR(1)")
F J=1:1 D Q:'BGPRECI
. N BGPRDA,BGPRERR,BGPRIENS
. S BGPRECI=$P($P(BGPREC,"*",J),"~",1)
. Q:'BGPRECI
. S BGPRIENS="+2,"_BGPIEN_","
. S BGPTDA(90245.992,BGPRIENS,.01)=BGPRECI
. D UPDATE^DIE("","BGPTDA","BGPRIENS","BGPRERR(1)")
I $G(BGPQUEUE) D
. S BGPTASK=$$CHKFQT^BGP3AUUL() ;check for currently queued task
. I BGPTASK D Q
.. S ZTSK=BGPTASK
.. D KILL^%ZTLOAD
. D SCHGUI^BGP3AUUL
I $G(BGPRUN) D
. D GUIDQ^BGP3AUUP
S RETVAL="^BGPTMP("_$J_")"
K ^BGPTMP($J)
S BGPI=0
S @RETVAL@(BGPI)="T00001Return"_$C(30)
S BGPI=BGPI+1
S @RETVAL@(BGPI)=$S($G(BGPRET)]"":BGPRET,$G(BGPTASK):BGPTASK,1:"")_$C(30)
S @RETVAL@(BGPI+1)=$C(31)
Q
;
CLNFAC(IE) ;-- clean out the facilities
S DA(1)=IE
S DIK="^BGPGP1PM("_DA(1)_",9,"
S DA=0 F S DA=$O(^BGPGP1PM(IE,9,DA)) Q:'DA D
. D ^DIK
Q
;
CLNREC(IR) ;-- clean out recipients
S DA(1)=IR
S DIK="^BGPGP1PM("_DA(1)_",99.2,"
S DA=0 F S DA=$O(^BGPGP1PM(IR,99.2,DA)) Q:'DA D
. D ^DIK
Q
;
CHKFQT(X) ;EP - check for queued task (BGP AUTO GPRA EXTRACT and BGPSITE variable within the task
NEW Y
S Y=$P($G(^BGPGUIK(X,0)),U,9)
I '$G(Y) Q 0
I '$D(^%ZTSK(Y,0)),$P($G(^BGPGUIK(X,0)),U,6)="R" Q 1 ;v16.0 check for deleted task and mark as errored if so
I $P($G(^%ZTSK(Y,.1)),U)="C" Q 1
I $P($G(^%ZTSK(Y,.1)),U)="E" Q 1
Q 0
;
UPLOG(GIEN,TSK) ;EP
S DIE="^BGPGUIK(",DR=".09///"_TSK
S DA=GIEN
D ^DIE
Q
;
BGPGUA ; IHS/CMI/LAB - BGP Gui Utilities 03/11/2010 3:28:39 PM ; 16 Oct 2014 12:11 PM
+1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
+2 ;
DEBUG(RETVAL,BGPSTR) ;run the debugger
+1 DO DEBUG^%Serenji("SEARCH^BGPGUA(.RETVAL,.BGPSTR)")
+2 QUIT
+3 ;
ADO ;EP -- setup the ADO string for each call
+1 ; m error trap
SET BGPX="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 KILL ^BGPTMP($JOB)
+3 SET RETVAL="^BGPTMP("_$JOB_")"
+4 QUIT
+5 ;
SEARCH(RETVAL,BGPSTR) ;-- return search results to Search
+1 NEW BGPDA,BGPI,P,BGPFL,BGPIDX,BGPGB,BGPS,BGPSZ,BGPL,BGPTGT,BGPFLDS,BGPSCR,BGPPR,BGPFLD1,BGPFLD2,BGPDT
+2 SET P="|"
+3 SET BGPI=0
+4 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 KILL ^BGPTMP($JOB)
+7 KILL ^BGPTMPD($JOB)
+8 ;target for find^dic lookup
SET BGPTGT="^BGPTMPD("_$JOB_")"
+9 SET BGPFL=$PIECE(BGPSTR,P)
+10 IF $EXTRACT(BGPFL,1,1)=0
SET BGPFL=+BGPFL
+11 SET BGPIDX=$PIECE(BGPSTR,P,2)
+12 IF BGPIDX]""
SET BGPIDX=$TRANSLATE(BGPIDX,"*","^")
+13 SET BGPS=$PIECE(BGPSTR,P,3)
+14 IF BGPFL=9002012.2
IF BGPS=""
SET BGPIDX="BA"
+15 SET BGPFLD1=$PIECE(BGPSTR,P,4)
+16 SET BGPFLD2=$PIECE(BGPSTR,P,5)
+17 SET BGPSCR=$PIECE(BGPSTR,P,6)
+18 SET BGPDT=$PIECE(BGPSTR,P,8)
+19 IF $GET(BGPSCR)[""
SET BGPSCR=$TRANSLATE(BGPSCR,"*","^")
+20 SET BGPPR=$PIECE(BGPSTR,P,7)
+21 SET BGPDT=$PIECE(BGPSTR,P,8)
+22 IF BGPFLD1["."
SET BGPFLD1=+BGPFLD1
+23 IF BGPFLD2["."
SET BGPFLD2=+BGPFLD2
+24 IF BGPFLD2=0
SET BGPFLD2=""
+25 SET BGPFLDS=$SELECT(BGPFLD2]"":BGPFLD1_";"_BGPFLD2,1:BGPFLD1)
+26 IF BGPS=""
Begin DoDot:1
+27 DO LIST^DIC(BGPFL,"",BGPFLDS,"","","",BGPS,BGPIDX,BGPSCR,"",BGPTGT,"BGPERRR(1)")
End DoDot:1
+28 IF BGPS]""
Begin DoDot:1
+29 DO FIND^DIC(BGPFL,"",BGPFLDS,"",BGPS,"",BGPIDX,BGPSCR,"",BGPTGT,"BGPERRR(1)")
End DoDot:1
+30 SET @RETVAL@(0)="T00010BMXIEN^T00050Value1^T00080Value2"_$CHAR(30)
+31 SET BGPDA=0
FOR
SET BGPDA=$ORDER(@BGPTGT@("DILIST","ID",BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+32 NEW BGPIEN,BGPBMX
+33 SET BGPIEN=0
FOR
SET BGPIEN=$ORDER(@BGPTGT@("DILIST","ID",BGPDA,BGPIEN))
IF 'BGPIEN
QUIT
Begin DoDot:2
+34 SET BGPBMX=$GET(@BGPTGT@("DILIST",2,BGPDA))
+35 SET BGPFLD(BGPIEN)=$GET(@BGPTGT@("DILIST","ID",BGPDA,BGPIEN))
End DoDot:2
+36 IF '$GET(BGPBMX)
QUIT
+37 SET BGPI=BGPI+1
+38 SET @RETVAL@(BGPI)=BGPBMX_U_BGPFLD(BGPFLD1)_U_$SELECT($GET(BGPFLD2):$GET(BGPFLD(BGPFLD2)),1:"")_$CHAR(30)
End DoDot:1
+39 SET @RETVAL@(BGPI+1)=$CHAR(31)
+40 QUIT
+41 ;
TIME(RETVAL,BGPSTR) ;-- get system time out based on user or location
+1 NEW P,BGPDUZ,BGPDUZ2,BGPI,BGPVAL,BGPVALI
+2 SET P="|"
+3 SET BGPDUZ=$PIECE(BGPSTR,P)
+4 SET BGPDUZ2=$PIECE(BGPSTR,P,2)
+5 SET BGPI=0
+6 SET RETVAL="^BGPTMP("_$JOB_")"
+7 KILL ^BGPTMP($JOB)
+8 SET @RETVAL@(BGPI)="T00010TimeOut"_$CHAR(30)
+9 SET BGPVAL=$$GET1^DIQ(200,BGPDUZ,200.1)
+10 IF '$GET(BGPVAL)
Begin DoDot:1
+11 SET BGPVAL=$$GET1^DIQ(8989.3,1,210)
End DoDot:1
+12 SET BGPI=BGPI+1
+13 SET @RETVAL@(BGPI)=$GET(BGPVAL)_$CHAR(30)
+14 SET @RETVAL@(BGPI+1)=$CHAR(31)
+15 QUIT
+16 ;
AUTO(RETVAL,BGPSTR) ;-- save the automated gpra parameters
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,P,BGPLOC,BGPTAX,BGPTYP,BGPDIR,BGPIP,BGPUSER,BGPPASS,BGPQUEUE,BGPRET,BGPTASK
+3 SET P="|"
+4 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+5 SET BGPLOC=$PIECE(BGPSTR,P)
+6 SET BGPTAX=$PIECE(BGPSTR,P,2)
+7 SET BGPTYP=$PIECE(BGPSTR,P,3)
+8 SET BGPDIR=$PIECE(BGPSTR,P,4)
+9 SET BGPIP=$PIECE(BGPSTR,P,5)
+10 SET BGPUSER=$PIECE(BGPSTR,P,6)
+11 SET BGPPASS=$PIECE(BGPSTR,P,7)
+12 SET BGPQUEUE=$PIECE(BGPSTR,P,8)
+13 SET BGPI=0
+14 IF '$ORDER(^BGPGP2PM("B",BGPLOC,0))
Begin DoDot:1
+15 NEW BGPFDA,BGPIENS,BGPERR
+16 SET BGPIENS(1)=BGPLOC
+17 SET BGPFDA(90241.04,"+1,",.01)=BGPLOC
+18 SET BGPFDA(90241.04,"+1,",.02)=BGPTYP
+19 SET BGPFDA(90241.04,"+1,",4.2)=BGPIP
+20 SET BGPFDA(90241.04,"+1,",4.3)=BGPDIR
+21 SET BGPFDA(90241.04,"+1,",4.4)=BGPUSER
+22 SET BGPFDA(90241.04,"+1,",4.5)=BGPPASS
+23 SET BGPFDA(90241.04,"+1,",5.1)=BGPTAX
+24 DO UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
+25 SET BGPRET=$GET(BGPIENS(1))
End DoDot:1
+26 IF $ORDER(^BGPGP2PM("B",BGPLOC,0))
Begin DoDot:1
+27 NEW BGPFDA,BGPIENS,BGPERR
+28 SET BGPIENS=$ORDER(^BGPGP2PM("B",BGPLOC,0))_","
+29 SET BGPFDA(90241.04,BGPIENS,.02)=BGPTYP
+30 SET BGPFDA(90241.04,BGPIENS,4.2)=BGPIP
+31 SET BGPFDA(90241.04,BGPIENS,4.3)=BGPDIR
+32 SET BGPFDA(90241.04,BGPIENS,4.4)=BGPUSER
+33 SET BGPFDA(90241.04,BGPIENS,4.5)=BGPPASS
+34 SET BGPFDA(90241.04,BGPIENS,5.1)=BGPTAX
+35 DO FILE^DIE("K","BGPFDA","BGPERR(1)")
+36 SET BGPRET=$GET(BGPIENS(1))
End DoDot:1
+37 IF $GET(BGPQUEUE)
Begin DoDot:1
+38 ;check for currently queued task
SET BGPTASK=$$CHKFQT^BGP3AUEX(BGPLOC)
+39 IF BGPTASK
Begin DoDot:2
+40 SET ZTSK=BGPTASK
+41 DO KILL^%ZTLOAD
End DoDot:2
QUIT
+42 DO SCHEDGUI^BGP3AUEX
End DoDot:1
+43 SET RETVAL="^BGPTMP("_$JOB_")"
+44 KILL ^BGPTMP($JOB)
+45 SET @RETVAL@(BGPI)="T00001Return"_$CHAR(30)
+46 SET BGPI=BGPI+1
+47 SET @RETVAL@(BGPI)=$SELECT($GET(BGPRET)]"":BGPRET,$GET(BGPTASK):BGPTASK,1:"")_$CHAR(30)
+48 SET @RETVAL@(BGPI+1)=$CHAR(31)
+49 QUIT
+50 ;
AUTOA(RETVAL,BGPSTR) ;-- save the area automated gpra parameters
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,P,BGPNAM,BGPTYP,BGPDIR,BGPSDIR,BGPALERT,BGPFAC,BGPREC,BGPQUEUE,BGPRUN,BGPRET,BGPTASK,BGPFACI,BGPRECI
+3 SET P="|"
+4 IF $GET(BGPSTR)=""
DO CATSTR^BGPGR(.BGPSTR,.BGPSTR)
+5 SET BGPNAM=$PIECE(BGPSTR,P)
+6 SET BGPTYP=$PIECE(BGPSTR,P,2)
+7 SET BGPDIR=$PIECE(BGPSTR,P,3)
+8 SET BGPSDIR=$PIECE(BGPSTR,P,4)
+9 SET BGPALERT=$PIECE(BGPSTR,P,5)
+10 SET BGPQUEUE=$PIECE(BGPSTR,P,6)
+11 SET BGPRUN=$PIECE(BGPSTR,P,7)
+12 SET BGPFAC=$PIECE(BGPSTR,P,8)
+13 SET BGPREC=$PIECE(BGPSTR,P,9)
+14 IF '$ORDER(^BGPGP1PM("B",BGPNAM,0))
Begin DoDot:1
+15 NEW BGPFDA,BGPIENS,BGPERR
+16 SET BGPIENS="+1,"
+17 SET BGPFDA(90245,"+1,",.01)=BGPNAM
+18 SET BGPFDA(90245,"+1,",.02)=BGPTYP
+19 SET BGPFDA(90245,"+1,",1.1)=BGPDIR
+20 SET BGPFDA(90245,"+1,",1.2)=BGPSDIR
+21 SET BGPFDA(90245,"+1,",99.1)=BGPALERT
+22 DO UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
+23 SET BGPRET=$GET(BGPIENS(1))
End DoDot:1
+24 IF $ORDER(^BGPGP1PM("B",BGPNAM,0))
Begin DoDot:1
+25 NEW BGPFDA,BGPIENS,BGPERR
+26 SET BGPIENS=$ORDER(^BGPGP1PM("B",BGPNAM,0))_","
+27 SET BGPFDA(90245,BGPIENS,.02)=BGPTYP
+28 SET BGPFDA(90245,BGPIENS,1.1)=BGPDIR
+29 SET BGPFDA(90245,BGPIENS,1.2)=BGPSDIR
+30 SET BGPFDA(90245,BGPIENS,99.1)=BGPALERT
+31 DO FILE^DIE("K","BGPFDA","BGPERR(1)")
+32 SET BGPRET=$GET(BGPIENS(1))
End DoDot:1
+33 SET BGPIEN=$ORDER(^BGPGP1PM("B",BGPNAM,0))
+34 DO CLNFAC(BGPIEN)
DO CLNREC(BGPIEN)
+35 FOR I=1:1
Begin DoDot:1
+36 NEW BGPTDA,BGPTERR,BGPTIENS
+37 SET BGPFACI=$PIECE($PIECE(BGPFAC,"*",I),"~",1)
+38 IF 'BGPFACI
QUIT
+39 SET BGPTIENS="+2,"_BGPIEN_","
+40 SET BGPTDA(90245.09,BGPTIENS,.01)=BGPFACI
+41 SET BGPTDA(90245.09,BGPTIENS,.02)=$$GET1^DIQ(9999999.06,BGPFACI,.12)
+42 SET BGPTDA(90245.09,BGPTIENS,.03)=1
+43 DO UPDATE^DIE("","BGPTDA","BGPTIENS","BGPTERR(1)")
End DoDot:1
IF 'BGPFACI
QUIT
+44 FOR J=1:1
Begin DoDot:1
+45 NEW BGPRDA,BGPRERR,BGPRIENS
+46 SET BGPRECI=$PIECE($PIECE(BGPREC,"*",J),"~",1)
+47 IF 'BGPRECI
QUIT
+48 SET BGPRIENS="+2,"_BGPIEN_","
+49 SET BGPTDA(90245.992,BGPRIENS,.01)=BGPRECI
+50 DO UPDATE^DIE("","BGPTDA","BGPRIENS","BGPRERR(1)")
End DoDot:1
IF 'BGPRECI
QUIT
+51 IF $GET(BGPQUEUE)
Begin DoDot:1
+52 ;check for currently queued task
SET BGPTASK=$$CHKFQT^BGP3AUUL()
+53 IF BGPTASK
Begin DoDot:2
+54 SET ZTSK=BGPTASK
+55 DO KILL^%ZTLOAD
End DoDot:2
QUIT
+56 DO SCHGUI^BGP3AUUL
End DoDot:1
+57 IF $GET(BGPRUN)
Begin DoDot:1
+58 DO GUIDQ^BGP3AUUP
End DoDot:1
+59 SET RETVAL="^BGPTMP("_$JOB_")"
+60 KILL ^BGPTMP($JOB)
+61 SET BGPI=0
+62 SET @RETVAL@(BGPI)="T00001Return"_$CHAR(30)
+63 SET BGPI=BGPI+1
+64 SET @RETVAL@(BGPI)=$SELECT($GET(BGPRET)]"":BGPRET,$GET(BGPTASK):BGPTASK,1:"")_$CHAR(30)
+65 SET @RETVAL@(BGPI+1)=$CHAR(31)
+66 QUIT
+67 ;
CLNFAC(IE) ;-- clean out the facilities
+1 SET DA(1)=IE
+2 SET DIK="^BGPGP1PM("_DA(1)_",9,"
+3 SET DA=0
FOR
SET DA=$ORDER(^BGPGP1PM(IE,9,DA))
IF 'DA
QUIT
Begin DoDot:1
+4 DO ^DIK
End DoDot:1
+5 QUIT
+6 ;
CLNREC(IR) ;-- clean out recipients
+1 SET DA(1)=IR
+2 SET DIK="^BGPGP1PM("_DA(1)_",99.2,"
+3 SET DA=0
FOR
SET DA=$ORDER(^BGPGP1PM(IR,99.2,DA))
IF 'DA
QUIT
Begin DoDot:1
+4 DO ^DIK
End DoDot:1
+5 QUIT
+6 ;
CHKFQT(X) ;EP - check for queued task (BGP AUTO GPRA EXTRACT and BGPSITE variable within the task
+1 NEW Y
+2 SET Y=$PIECE($GET(^BGPGUIK(X,0)),U,9)
+3 IF '$GET(Y)
QUIT 0
+4 ;v16.0 check for deleted task and mark as errored if so
IF '$DATA(^%ZTSK(Y,0))
IF $PIECE($GET(^BGPGUIK(X,0)),U,6)="R"
QUIT 1
+5 IF $PIECE($GET(^%ZTSK(Y,.1)),U)="C"
QUIT 1
+6 IF $PIECE($GET(^%ZTSK(Y,.1)),U)="E"
QUIT 1
+7 QUIT 0
+8 ;
UPLOG(GIEN,TSK) ;EP
+1 SET DIE="^BGPGUIK("
SET DR=".09///"_TSK
+2 SET DA=GIEN
+3 DO ^DIE
+4 QUIT
+5 ;
