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

BGPGTA.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  ;
  1. AUTO(RETVAL,BGPSTR) ;--return automated parameters
  1.  S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
  1.  N BGPI,P,BGPLOC,BGPTAX,BGPTYP,BGPDIR,BGPIP,BGPUSER,BGPPASS,BGPQUEUE,BGPZERO,BGPONE,BGPFOUR,BGPFIVE,BGPTASK
  1.  S P="|"
  1.  K ^BGPTMP($J)
  1.  S RETVAL="^BGPTMP("_$J_")"
  1.  S BGPI=0
  1.  S BGPLOC=$P(BGPSTR,P)
  1.  S ^BGPTMP($J,BGPI)="T00080Location^T00080Taxonomy^T00030Type^T00080Directory^T00030IP^T00030Username^T00030Password^T00001Queue"_$C(30)
  1.  I '$O(^BGPGP2PM("B",BGPLOC,0)) D  Q
  1.  . S ^BGPTMP($J,BGPI+1)=$C(31)
  1.  S BGPZERO=$G(^BGPGP2PM(BGPLOC,0))
  1.  S BGPONE=$G(^BGPGP2PM(BGPLOC,1))
  1.  S BGPFOUR=$G(^BGPGP2PM(BGPLOC,4))
  1.  S BGPFIVE=$G(^BGPGP2PM(BGPLOC,5))
  1.  S BGPTAX=$S($G(BGPFIVE):$G(BGPFIVE)_"~"_$$GET1^DIQ(9002226,BGPFIVE,.01),1:"")
  1.  S BGPTYP=$P(BGPZERO,U,2)
  1.  S BGPDIR=$P(BGPFOUR,U,3)
  1.  S BGPIP=$P(BGPFOUR,U,2)
  1.  S BGPUSER=$P(BGPFOUR,U,4)
  1.  S BGPPASS=$P(BGPFOUR,U,5)
  1.  S BGPTASK=$$CHKFQT^BGP3AUEX(BGPLOC)  ;check for currently queued task
  1.  I $G(BGPTASK) S BGPQUEUE=1
  1.  S BGPI=BGPI+1
  1.  S ^BGPTMP($J,BGPI)=BGPLOC_U_BGPTAX_U_BGPTYP_U_BGPDIR_U_BGPIP_U_BGPUSER_U_BGPPASS_U_$G(BGPQUEUE)_$C(30)
  1.  S ^BGPTMP($J,BGPI+1)=$C(31)
  1.  Q
  1.  ;
  1. AUTOA(RETVAL) ;--return area automated parameters
  1.  S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
  1.  N BGPI,BGPNAME,BGPIEN,BGPTYP,BGPDIR,BGPSDIR,BGPUSER,BGPREC,BGPFAC,BGPQUEUE,BGPZERO,BGPONE,BGPTASK
  1.  K ^BGPTMP($J)
  1.  S RETVAL="^BGPTMP("_$J_")"
  1.  S BGPI=0
  1.  S ^BGPTMP($J,BGPI)="T00030Name^T00030Type^T00080Directory^T00080Subdirectory^T00050Alert^T00001Queue^T02500Facilities^T02500Recipients"_$C(30)
  1.  I $O(^BGPGP1PM("B",0))="" D  Q
  1.  . S ^BGPTMP($J,BGPI+1)=$C(31)
  1.  S BGPNAME=$O(^BGPGP1PM("B",0))
  1.  S BGPIEN=$O(^BGPGP1PM("B",BGPNAME,0))
  1.  S BGPZERO=$G(^BGPGP1PM(BGPIEN,0))
  1.  S BGPONE=$G(^BGPGP1PM(BGPIEN,1))
  1.  S BGPNINE=$G(^BGPGP1PM(BGPIEN,99.1))
  1.  S BGPTYP=$P(BGPZERO,U,2)
  1.  S BGPDIR=$P(BGPONE,U)
  1.  S BGPSDIR=$P(BGPONE,U,2)
  1.  S BGPUSER=$G(BGPNINE) I BGPUSER S BGPUSER=BGPUSER_"~"_$$GET1^DIQ(200,BGPUSER,.01)
  1.  N BGPDA,BGPND
  1.  S BGPREC=""
  1.  S BGPDA=0 F  S BGPDA=$O(^BGPGP1PM(BGPIEN,99.2,BGPDA)) Q:'BGPDA  D
  1.  . S BGPND=$G(^BGPGP1PM(BGPIEN,99.2,BGPDA,0))
  1.  . I BGPND S BGPND=BGPND_"~"_$$GET1^DIQ(200,BGPND,.01)
  1.  . S BGPREC=BGPREC_BGPND_"*"
  1.  N BGPFDA,BGPFND
  1.  S BGPFAC=""
  1.  S BGPFDA=0 F  S BGPFDA=$O(^BGPGP1PM(BGPIEN,9,BGPFDA)) Q:'BGPFDA  D
  1.  . S BGPFND=+$G(^BGPGP1PM(BGPIEN,9,BGPFDA,0))
  1.  . I BGPFND S BGPFND=BGPFND_"~"_$$GET1^DIQ(4,BGPFND,.01)_"~"_$P($G(^BGPGP1PM(BGPIEN,9,BGPFDA,0)),U,2)
  1.  . S BGPFAC=BGPFAC_BGPFND_"*"
  1.  S BGPTASK=$$CHKFQT^BGP3AUUL()  ;check for currently queued task
  1.  I $G(BGPTASK) S BGPQUEUE=1
  1.  S BGPI=BGPI+1
  1.  S ^BGPTMP($J,BGPI)=BGPNAME_U_BGPTYP_U_BGPDIR_U_BGPSDIR_U_BGPUSER_U_$G(BGPQUEUE)_U_BGPFAC_U_BGPREC_$C(30)
  1.  S ^BGPTMP($J,BGPI+1)=$C(31)
  1.  Q
  1.  ;