BGPGTA ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
;
;
AUTO(RETVAL,BGPSTR) ;--return automated parameters
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,P,BGPLOC,BGPTAX,BGPTYP,BGPDIR,BGPIP,BGPUSER,BGPPASS,BGPQUEUE,BGPZERO,BGPONE,BGPFOUR,BGPFIVE,BGPTASK
S P="|"
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S BGPLOC=$P(BGPSTR,P)
S ^BGPTMP($J,BGPI)="T00080Location^T00080Taxonomy^T00030Type^T00080Directory^T00030IP^T00030Username^T00030Password^T00001Queue"_$C(30)
I '$O(^BGPGP2PM("B",BGPLOC,0)) D Q
. S ^BGPTMP($J,BGPI+1)=$C(31)
S BGPZERO=$G(^BGPGP2PM(BGPLOC,0))
S BGPONE=$G(^BGPGP2PM(BGPLOC,1))
S BGPFOUR=$G(^BGPGP2PM(BGPLOC,4))
S BGPFIVE=$G(^BGPGP2PM(BGPLOC,5))
S BGPTAX=$S($G(BGPFIVE):$G(BGPFIVE)_"~"_$$GET1^DIQ(9002226,BGPFIVE,.01),1:"")
S BGPTYP=$P(BGPZERO,U,2)
S BGPDIR=$P(BGPFOUR,U,3)
S BGPIP=$P(BGPFOUR,U,2)
S BGPUSER=$P(BGPFOUR,U,4)
S BGPPASS=$P(BGPFOUR,U,5)
S BGPTASK=$$CHKFQT^BGP3AUEX(BGPLOC) ;check for currently queued task
I $G(BGPTASK) S BGPQUEUE=1
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=BGPLOC_U_BGPTAX_U_BGPTYP_U_BGPDIR_U_BGPIP_U_BGPUSER_U_BGPPASS_U_$G(BGPQUEUE)_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
Q
;
AUTOA(RETVAL) ;--return area automated parameters
S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
N BGPI,BGPNAME,BGPIEN,BGPTYP,BGPDIR,BGPSDIR,BGPUSER,BGPREC,BGPFAC,BGPQUEUE,BGPZERO,BGPONE,BGPTASK
K ^BGPTMP($J)
S RETVAL="^BGPTMP("_$J_")"
S BGPI=0
S ^BGPTMP($J,BGPI)="T00030Name^T00030Type^T00080Directory^T00080Subdirectory^T00050Alert^T00001Queue^T02500Facilities^T02500Recipients"_$C(30)
I $O(^BGPGP1PM("B",0))="" D Q
. S ^BGPTMP($J,BGPI+1)=$C(31)
S BGPNAME=$O(^BGPGP1PM("B",0))
S BGPIEN=$O(^BGPGP1PM("B",BGPNAME,0))
S BGPZERO=$G(^BGPGP1PM(BGPIEN,0))
S BGPONE=$G(^BGPGP1PM(BGPIEN,1))
S BGPNINE=$G(^BGPGP1PM(BGPIEN,99.1))
S BGPTYP=$P(BGPZERO,U,2)
S BGPDIR=$P(BGPONE,U)
S BGPSDIR=$P(BGPONE,U,2)
S BGPUSER=$G(BGPNINE) I BGPUSER S BGPUSER=BGPUSER_"~"_$$GET1^DIQ(200,BGPUSER,.01)
N BGPDA,BGPND
S BGPREC=""
S BGPDA=0 F S BGPDA=$O(^BGPGP1PM(BGPIEN,99.2,BGPDA)) Q:'BGPDA D
. S BGPND=$G(^BGPGP1PM(BGPIEN,99.2,BGPDA,0))
. I BGPND S BGPND=BGPND_"~"_$$GET1^DIQ(200,BGPND,.01)
. S BGPREC=BGPREC_BGPND_"*"
N BGPFDA,BGPFND
S BGPFAC=""
S BGPFDA=0 F S BGPFDA=$O(^BGPGP1PM(BGPIEN,9,BGPFDA)) Q:'BGPFDA D
. S BGPFND=+$G(^BGPGP1PM(BGPIEN,9,BGPFDA,0))
. I BGPFND S BGPFND=BGPFND_"~"_$$GET1^DIQ(4,BGPFND,.01)_"~"_$P($G(^BGPGP1PM(BGPIEN,9,BGPFDA,0)),U,2)
. S BGPFAC=BGPFAC_BGPFND_"*"
S BGPTASK=$$CHKFQT^BGP3AUUL() ;check for currently queued task
I $G(BGPTASK) S BGPQUEUE=1
S BGPI=BGPI+1
S ^BGPTMP($J,BGPI)=BGPNAME_U_BGPTYP_U_BGPDIR_U_BGPSDIR_U_BGPUSER_U_$G(BGPQUEUE)_U_BGPFAC_U_BGPREC_$C(30)
S ^BGPTMP($J,BGPI+1)=$C(31)
Q
;
BGPGTA ; IHS/CMI/LAB - BGPG Gui CRS Tables 2/2/2005 10:24:22 AM ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
+3 ;
+4 ;
AUTO(RETVAL,BGPSTR) ;--return automated parameters
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,P,BGPLOC,BGPTAX,BGPTYP,BGPDIR,BGPIP,BGPUSER,BGPPASS,BGPQUEUE,BGPZERO,BGPONE,BGPFOUR,BGPFIVE,BGPTASK
+3 SET P="|"
+4 KILL ^BGPTMP($JOB)
+5 SET RETVAL="^BGPTMP("_$JOB_")"
+6 SET BGPI=0
+7 SET BGPLOC=$PIECE(BGPSTR,P)
+8 SET ^BGPTMP($JOB,BGPI)="T00080Location^T00080Taxonomy^T00030Type^T00080Directory^T00030IP^T00030Username^T00030Password^T00001Queue"_$CHAR(30)
+9 IF '$ORDER(^BGPGP2PM("B",BGPLOC,0))
Begin DoDot:1
+10 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
End DoDot:1
QUIT
+11 SET BGPZERO=$GET(^BGPGP2PM(BGPLOC,0))
+12 SET BGPONE=$GET(^BGPGP2PM(BGPLOC,1))
+13 SET BGPFOUR=$GET(^BGPGP2PM(BGPLOC,4))
+14 SET BGPFIVE=$GET(^BGPGP2PM(BGPLOC,5))
+15 SET BGPTAX=$SELECT($GET(BGPFIVE):$GET(BGPFIVE)_"~"_$$GET1^DIQ(9002226,BGPFIVE,.01),1:"")
+16 SET BGPTYP=$PIECE(BGPZERO,U,2)
+17 SET BGPDIR=$PIECE(BGPFOUR,U,3)
+18 SET BGPIP=$PIECE(BGPFOUR,U,2)
+19 SET BGPUSER=$PIECE(BGPFOUR,U,4)
+20 SET BGPPASS=$PIECE(BGPFOUR,U,5)
+21 ;check for currently queued task
SET BGPTASK=$$CHKFQT^BGP3AUEX(BGPLOC)
+22 IF $GET(BGPTASK)
SET BGPQUEUE=1
+23 SET BGPI=BGPI+1
+24 SET ^BGPTMP($JOB,BGPI)=BGPLOC_U_BGPTAX_U_BGPTYP_U_BGPDIR_U_BGPIP_U_BGPUSER_U_BGPPASS_U_$GET(BGPQUEUE)_$CHAR(30)
+25 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+26 QUIT
+27 ;
AUTOA(RETVAL) ;--return area automated parameters
+1 ; m error trap
SET X="MERR^BGPGU"
SET @^%ZOSF("TRAP")
+2 NEW BGPI,BGPNAME,BGPIEN,BGPTYP,BGPDIR,BGPSDIR,BGPUSER,BGPREC,BGPFAC,BGPQUEUE,BGPZERO,BGPONE,BGPTASK
+3 KILL ^BGPTMP($JOB)
+4 SET RETVAL="^BGPTMP("_$JOB_")"
+5 SET BGPI=0
+6 SET ^BGPTMP($JOB,BGPI)="T00030Name^T00030Type^T00080Directory^T00080Subdirectory^T00050Alert^T00001Queue^T02500Facilities^T02500Recipients"_$CHAR(30)
+7 IF $ORDER(^BGPGP1PM("B",0))=""
Begin DoDot:1
+8 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
End DoDot:1
QUIT
+9 SET BGPNAME=$ORDER(^BGPGP1PM("B",0))
+10 SET BGPIEN=$ORDER(^BGPGP1PM("B",BGPNAME,0))
+11 SET BGPZERO=$GET(^BGPGP1PM(BGPIEN,0))
+12 SET BGPONE=$GET(^BGPGP1PM(BGPIEN,1))
+13 SET BGPNINE=$GET(^BGPGP1PM(BGPIEN,99.1))
+14 SET BGPTYP=$PIECE(BGPZERO,U,2)
+15 SET BGPDIR=$PIECE(BGPONE,U)
+16 SET BGPSDIR=$PIECE(BGPONE,U,2)
+17 SET BGPUSER=$GET(BGPNINE)
IF BGPUSER
SET BGPUSER=BGPUSER_"~"_$$GET1^DIQ(200,BGPUSER,.01)
+18 NEW BGPDA,BGPND
+19 SET BGPREC=""
+20 SET BGPDA=0
FOR
SET BGPDA=$ORDER(^BGPGP1PM(BGPIEN,99.2,BGPDA))
IF 'BGPDA
QUIT
Begin DoDot:1
+21 SET BGPND=$GET(^BGPGP1PM(BGPIEN,99.2,BGPDA,0))
+22 IF BGPND
SET BGPND=BGPND_"~"_$$GET1^DIQ(200,BGPND,.01)
+23 SET BGPREC=BGPREC_BGPND_"*"
End DoDot:1
+24 NEW BGPFDA,BGPFND
+25 SET BGPFAC=""
+26 SET BGPFDA=0
FOR
SET BGPFDA=$ORDER(^BGPGP1PM(BGPIEN,9,BGPFDA))
IF 'BGPFDA
QUIT
Begin DoDot:1
+27 SET BGPFND=+$GET(^BGPGP1PM(BGPIEN,9,BGPFDA,0))
+28 IF BGPFND
SET BGPFND=BGPFND_"~"_$$GET1^DIQ(4,BGPFND,.01)_"~"_$PIECE($GET(^BGPGP1PM(BGPIEN,9,BGPFDA,0)),U,2)
+29 SET BGPFAC=BGPFAC_BGPFND_"*"
End DoDot:1
+30 ;check for currently queued task
SET BGPTASK=$$CHKFQT^BGP3AUUL()
+31 IF $GET(BGPTASK)
SET BGPQUEUE=1
+32 SET BGPI=BGPI+1
+33 SET ^BGPTMP($JOB,BGPI)=BGPNAME_U_BGPTYP_U_BGPDIR_U_BGPSDIR_U_BGPUSER_U_$GET(BGPQUEUE)_U_BGPFAC_U_BGPREC_$CHAR(30)
+34 SET ^BGPTMP($JOB,BGPI+1)=$CHAR(31)
+35 QUIT
+36 ;
