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

BGPGUA.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. DEBUG(RETVAL,BGPSTR) ;run the debugger
  1.  D DEBUG^%Serenji("SEARCH^BGPGUA(.RETVAL,.BGPSTR)")
  1.  Q
  1.  ;
  1. ADO ;EP -- setup the ADO string for each call
  1.  S BGPX="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
  1.  K ^BGPTMP($J)
  1.  S RETVAL="^BGPTMP("_$J_")"
  1.  Q
  1.  ;
  1.  N BGPDA,BGPI,P,BGPFL,BGPIDX,BGPGB,BGPS,BGPSZ,BGPL,BGPTGT,BGPFLDS,BGPSCR,BGPPR,BGPFLD1,BGPFLD2,BGPDT
  1.  S P="|"
  1.  S BGPI=0
  1.  S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
  1.  S RETVAL="^BGPTMP("_$J_")"
  1.  K ^BGPTMP($J)
  1.  K ^BGPTMPD($J)
  1.  S BGPTGT="^BGPTMPD("_$J_")"  ;target for find^dic lookup
  1.  S BGPFL=$P(BGPSTR,P)
  1.  I $E(BGPFL,1,1)=0 S BGPFL=+BGPFL
  1.  S BGPIDX=$P(BGPSTR,P,2)
  1.  I BGPIDX]"" S BGPIDX=$TR(BGPIDX,"*","^")
  1.  S BGPS=$P(BGPSTR,P,3)
  1.  I BGPFL=9002012.2,BGPS="" S BGPIDX="BA"
  1.  S BGPFLD1=$P(BGPSTR,P,4)
  1.  S BGPFLD2=$P(BGPSTR,P,5)
  1.  S BGPSCR=$P(BGPSTR,P,6)
  1.  S BGPDT=$P(BGPSTR,P,8)
  1.  I $G(BGPSCR)["" S BGPSCR=$TR(BGPSCR,"*","^")
  1.  S BGPPR=$P(BGPSTR,P,7)
  1.  S BGPDT=$P(BGPSTR,P,8)
  1.  I BGPFLD1["." S BGPFLD1=+BGPFLD1
  1.  I BGPFLD2["." S BGPFLD2=+BGPFLD2
  1.  I BGPFLD2=0 S BGPFLD2=""
  1.  S BGPFLDS=$S(BGPFLD2]"":BGPFLD1_";"_BGPFLD2,1:BGPFLD1)
  1.  I BGPS="" D
  1.  . D LIST^DIC(BGPFL,"",BGPFLDS,"","","",BGPS,BGPIDX,BGPSCR,"",BGPTGT,"BGPERRR(1)")
  1.  I BGPS]"" D
  1.  . D FIND^DIC(BGPFL,"",BGPFLDS,"",BGPS,"",BGPIDX,BGPSCR,"",BGPTGT,"BGPERRR(1)")
  1.  S @RETVAL@(0)="T00010BMXIEN^T00050Value1^T00080Value2"_$C(30)
  1.  S BGPDA=0  F  S BGPDA=$O(@BGPTGT@("DILIST","ID",BGPDA)) Q:'BGPDA  D
  1.  . N BGPIEN,BGPBMX
  1.  . S BGPIEN=0 F  S BGPIEN=$O(@BGPTGT@("DILIST","ID",BGPDA,BGPIEN)) Q:'BGPIEN  D
  1.  .. S BGPBMX=$G(@BGPTGT@("DILIST",2,BGPDA))
  1.  .. S BGPFLD(BGPIEN)=$G(@BGPTGT@("DILIST","ID",BGPDA,BGPIEN))
  1.  . Q:'$G(BGPBMX)
  1.  . S BGPI=BGPI+1
  1.  . S @RETVAL@(BGPI)=BGPBMX_U_BGPFLD(BGPFLD1)_U_$S($G(BGPFLD2):$G(BGPFLD(BGPFLD2)),1:"")_$C(30)
  1.  S @RETVAL@(BGPI+1)=$C(31)
  1.  Q
  1.  ;
  1. TIME(RETVAL,BGPSTR) ;-- get system time out based on user or location
  1.  N P,BGPDUZ,BGPDUZ2,BGPI,BGPVAL,BGPVALI
  1.  S P="|"
  1.  S BGPDUZ=$P(BGPSTR,P)
  1.  S BGPDUZ2=$P(BGPSTR,P,2)
  1.  S BGPI=0
  1.  S RETVAL="^BGPTMP("_$J_")"
  1.  K ^BGPTMP($J)
  1.  S @RETVAL@(BGPI)="T00010TimeOut"_$C(30)
  1.  S BGPVAL=$$GET1^DIQ(200,BGPDUZ,200.1)
  1.  I '$G(BGPVAL) D
  1.  . S BGPVAL=$$GET1^DIQ(8989.3,1,210)
  1.  S BGPI=BGPI+1
  1.  S @RETVAL@(BGPI)=$G(BGPVAL)_$C(30)
  1.  S @RETVAL@(BGPI+1)=$C(31)
  1.  Q
  1.  ;
  1. AUTO(RETVAL,BGPSTR) ;-- save the automated gpra parameters
  1.  S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
  1.  N BGPI,P,BGPLOC,BGPTAX,BGPTYP,BGPDIR,BGPIP,BGPUSER,BGPPASS,BGPQUEUE,BGPRET,BGPTASK
  1.  S P="|"
  1.  I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
  1.  S BGPLOC=$P(BGPSTR,P)
  1.  S BGPTAX=$P(BGPSTR,P,2)
  1.  S BGPTYP=$P(BGPSTR,P,3)
  1.  S BGPDIR=$P(BGPSTR,P,4)
  1.  S BGPIP=$P(BGPSTR,P,5)
  1.  S BGPUSER=$P(BGPSTR,P,6)
  1.  S BGPPASS=$P(BGPSTR,P,7)
  1.  S BGPQUEUE=$P(BGPSTR,P,8)
  1.  S BGPI=0
  1.  I '$O(^BGPGP2PM("B",BGPLOC,0)) D
  1.  . N BGPFDA,BGPIENS,BGPERR
  1.  . S BGPIENS(1)=BGPLOC
  1.  . S BGPFDA(90241.04,"+1,",.01)=BGPLOC
  1.  . S BGPFDA(90241.04,"+1,",.02)=BGPTYP
  1.  . S BGPFDA(90241.04,"+1,",4.2)=BGPIP
  1.  . S BGPFDA(90241.04,"+1,",4.3)=BGPDIR
  1.  . S BGPFDA(90241.04,"+1,",4.4)=BGPUSER
  1.  . S BGPFDA(90241.04,"+1,",4.5)=BGPPASS
  1.  . S BGPFDA(90241.04,"+1,",5.1)=BGPTAX
  1.  . D UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
  1.  . S BGPRET=$G(BGPIENS(1))
  1.  I $O(^BGPGP2PM("B",BGPLOC,0)) D
  1.  . N BGPFDA,BGPIENS,BGPERR
  1.  . S BGPIENS=$O(^BGPGP2PM("B",BGPLOC,0))_","
  1.  . S BGPFDA(90241.04,BGPIENS,.02)=BGPTYP
  1.  . S BGPFDA(90241.04,BGPIENS,4.2)=BGPIP
  1.  . S BGPFDA(90241.04,BGPIENS,4.3)=BGPDIR
  1.  . S BGPFDA(90241.04,BGPIENS,4.4)=BGPUSER
  1.  . S BGPFDA(90241.04,BGPIENS,4.5)=BGPPASS
  1.  . S BGPFDA(90241.04,BGPIENS,5.1)=BGPTAX
  1.  . D FILE^DIE("K","BGPFDA","BGPERR(1)")
  1.  . S BGPRET=$G(BGPIENS(1))
  1.  I $G(BGPQUEUE) D
  1.  . S BGPTASK=$$CHKFQT^BGP3AUEX(BGPLOC)  ;check for currently queued task
  1.  . I BGPTASK D  Q
  1.  .. S ZTSK=BGPTASK
  1.  .. D KILL^%ZTLOAD
  1.  . D SCHEDGUI^BGP3AUEX
  1.  S RETVAL="^BGPTMP("_$J_")"
  1.  K ^BGPTMP($J)
  1.  S @RETVAL@(BGPI)="T00001Return"_$C(30)
  1.  S BGPI=BGPI+1
  1.  S @RETVAL@(BGPI)=$S($G(BGPRET)]"":BGPRET,$G(BGPTASK):BGPTASK,1:"")_$C(30)
  1.  S @RETVAL@(BGPI+1)=$C(31)
  1.  Q
  1.  ;
  1. AUTOA(RETVAL,BGPSTR) ;-- save the area automated gpra parameters
  1.  S X="MERR^BGPGU",@^%ZOSF("TRAP") ; m error trap
  1.  N BGPI,P,BGPNAM,BGPTYP,BGPDIR,BGPSDIR,BGPALERT,BGPFAC,BGPREC,BGPQUEUE,BGPRUN,BGPRET,BGPTASK,BGPFACI,BGPRECI
  1.  S P="|"
  1.  I $G(BGPSTR)="" D CATSTR^BGPGR(.BGPSTR,.BGPSTR)
  1.  S BGPNAM=$P(BGPSTR,P)
  1.  S BGPTYP=$P(BGPSTR,P,2)
  1.  S BGPDIR=$P(BGPSTR,P,3)
  1.  S BGPSDIR=$P(BGPSTR,P,4)
  1.  S BGPALERT=$P(BGPSTR,P,5)
  1.  S BGPQUEUE=$P(BGPSTR,P,6)
  1.  S BGPRUN=$P(BGPSTR,P,7)
  1.  S BGPFAC=$P(BGPSTR,P,8)
  1.  S BGPREC=$P(BGPSTR,P,9)
  1.  I '$O(^BGPGP1PM("B",BGPNAM,0)) D
  1.  . N BGPFDA,BGPIENS,BGPERR
  1.  . S BGPIENS="+1,"
  1.  . S BGPFDA(90245,"+1,",.01)=BGPNAM
  1.  . S BGPFDA(90245,"+1,",.02)=BGPTYP
  1.  . S BGPFDA(90245,"+1,",1.1)=BGPDIR
  1.  . S BGPFDA(90245,"+1,",1.2)=BGPSDIR
  1.  . S BGPFDA(90245,"+1,",99.1)=BGPALERT
  1.  . D UPDATE^DIE("","BGPFDA","BGPIENS","BGPERR(1)")
  1.  . S BGPRET=$G(BGPIENS(1))
  1.  I $O(^BGPGP1PM("B",BGPNAM,0)) D
  1.  . N BGPFDA,BGPIENS,BGPERR
  1.  . S BGPIENS=$O(^BGPGP1PM("B",BGPNAM,0))_","
  1.  . S BGPFDA(90245,BGPIENS,.02)=BGPTYP
  1.  . S BGPFDA(90245,BGPIENS,1.1)=BGPDIR
  1.  . S BGPFDA(90245,BGPIENS,1.2)=BGPSDIR
  1.  . S BGPFDA(90245,BGPIENS,99.1)=BGPALERT
  1.  . D FILE^DIE("K","BGPFDA","BGPERR(1)")
  1.  . S BGPRET=$G(BGPIENS(1))
  1.  S BGPIEN=$O(^BGPGP1PM("B",BGPNAM,0))
  1.  D CLNFAC(BGPIEN),CLNREC(BGPIEN)
  1.  F I=1:1 D  Q:'BGPFACI
  1.  . N BGPTDA,BGPTERR,BGPTIENS
  1.  . S BGPFACI=$P($P(BGPFAC,"*",I),"~",1)
  1.  . Q:'BGPFACI
  1.  . S BGPTIENS="+2,"_BGPIEN_","
  1.  . S BGPTDA(90245.09,BGPTIENS,.01)=BGPFACI
  1.  . S BGPTDA(90245.09,BGPTIENS,.02)=$$GET1^DIQ(9999999.06,BGPFACI,.12)
  1.  . S BGPTDA(90245.09,BGPTIENS,.03)=1
  1.  . D UPDATE^DIE("","BGPTDA","BGPTIENS","BGPTERR(1)")
  1.  F J=1:1 D  Q:'BGPRECI
  1.  . N BGPRDA,BGPRERR,BGPRIENS
  1.  . S BGPRECI=$P($P(BGPREC,"*",J),"~",1)
  1.  . Q:'BGPRECI
  1.  . S BGPRIENS="+2,"_BGPIEN_","
  1.  . S BGPTDA(90245.992,BGPRIENS,.01)=BGPRECI
  1.  . D UPDATE^DIE("","BGPTDA","BGPRIENS","BGPRERR(1)")
  1.  I $G(BGPQUEUE) D
  1.  . S BGPTASK=$$CHKFQT^BGP3AUUL()  ;check for currently queued task
  1.  . I BGPTASK D  Q
  1.  .. S ZTSK=BGPTASK
  1.  .. D KILL^%ZTLOAD
  1.  . D SCHGUI^BGP3AUUL
  1.  I $G(BGPRUN) D
  1.  . D GUIDQ^BGP3AUUP
  1.  S RETVAL="^BGPTMP("_$J_")"
  1.  K ^BGPTMP($J)
  1.  S BGPI=0
  1.  S @RETVAL@(BGPI)="T00001Return"_$C(30)
  1.  S BGPI=BGPI+1
  1.  S @RETVAL@(BGPI)=$S($G(BGPRET)]"":BGPRET,$G(BGPTASK):BGPTASK,1:"")_$C(30)
  1.  S @RETVAL@(BGPI+1)=$C(31)
  1.  Q
  1.  ;
  1. CLNFAC(IE) ;-- clean out the facilities
  1.  S DA(1)=IE
  1.  S DIK="^BGPGP1PM("_DA(1)_",9,"
  1.  S DA=0 F  S DA=$O(^BGPGP1PM(IE,9,DA)) Q:'DA  D
  1.  . D ^DIK
  1.  Q
  1.  ;
  1. CLNREC(IR) ;-- clean out recipients
  1.  S DA(1)=IR
  1.  S DIK="^BGPGP1PM("_DA(1)_",99.2,"
  1.  S DA=0 F  S DA=$O(^BGPGP1PM(IR,99.2,DA)) Q:'DA  D
  1.  . D ^DIK
  1.  Q
  1.  ;
  1. CHKFQT(X) ;EP - check for queued task (BGP AUTO GPRA EXTRACT and BGPSITE variable within the task
  1.  NEW Y
  1.  S Y=$P($G(^BGPGUIK(X,0)),U,9)
  1.  I '$G(Y) Q 0
  1.  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
  1.  I $P($G(^%ZTSK(Y,.1)),U)="C" Q 1
  1.  I $P($G(^%ZTSK(Y,.1)),U)="E" Q 1
  1.  Q 0
  1.  ;
  1. UPLOG(GIEN,TSK) ;EP
  1.  S DIE="^BGPGUIK(",DR=".09///"_TSK
  1.  S DA=GIEN
  1.  D ^DIE
  1.  Q
  1.  ;