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

ALPBGEN2.m

Go to the documentation of this file.
  1. ALPBGEN2 ;SFVAMC/JC - Init New Person Data on Workstations ;05/12/2003 07:40
  1. ;;3.0;BAR CODE MED ADMIN;**8,102**;Mar 2004;Build 14
  1. ;
  1. ; Reference/IA
  1. ; DEQUE^XUSERP/4511
  1. ;
  1. INIT ;Initial Load
  1. N DIR,DTOUT,DUOUT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. ;Populate workstations with Vista New Person data
  1. W !,"This option searches for users that hold the option, 'PSB GUI CONTEXT - USER'"
  1. W !,"and if they are active users, transmits the information to your BCMA Backup Workstations."
  1. W !,"NOTE that you must have completed the step of assigning workstations to either a"
  1. W !,"single default group or by division."
  1. W !!,"Do you wish to continue?" S DIR(0)="YA",DIR("B")="YES" D ^DIR
  1. Q:Y<1!($D(DTOUT))!($D(DUOUT))
  1. W !!,"Do you wish to queue this init?" S DIR(0)="YA",DIR("B")="YES" D ^DIR
  1. Q:($D(DTOUT))!($D(DUOUT))
  1. I Y D Q
  1. . S ZTRTN="Q^ALPBGEN2",ZTDESC="BCBU New Person Init",ZTSAVE("*")="",ZTIO=""
  1. . D ^%ZTLOAD I $D(ZTSK) W !,"TASK #: ",ZTSK
  1. Q ;
  1. N ALPBI,ALPBJ,ALPBK
  1. S DTS=$$FMTE^XLFDT($$NOW^XLFDT)
  1. S (ALPBK)=0,ALPBJ="" F S ALPBJ=$O(^VA(200,ALPBJ)) Q:ALPBJ="" D
  1. . Q:+ALPBJ<1
  1. . I $$ISBCMA(ALPBJ)>0 D
  1. . . I '$D(ZTSK) W !,ALPBJ_" "_$P(^VA(200,ALPBJ,0),U)
  1. . . D DEQUE^XUSERP(ALPBJ,1)
  1. . . K HLA,HL
  1. . . S ALPBK=$G(ALPBK)+1
  1. K XQA,XQAMSG
  1. S DTE=$$FMTE^XLFDT($$NOW^XLFDT)
  1. S XQA(DUZ)=""
  1. S XQAMSG="BCBU INIT Start:"_DTS_" Finish:"_DTE_". "_ALPBK_" users sent."
  1. D SETUP^XQALERT
  1. K DTS,DTE,ALPBK
  1. Q
  1. ISBCMA(USER) ;Does this person have BCMA access?
  1. ;Returns 0 if no such user
  1. ;user terminated or no access code
  1. ;no option in file
  1. ;no access due to locks
  1. ;Returns 1 if user has the PSB GUI CONTEXT - USER option
  1. N OPT
  1. S DIC="^DIC(19,",DIC(0)="MX",X="PSB GUI CONTEXT - USER"
  1. D ^DIC K DIC,DA,DR
  1. I +Y<1 Q 0
  1. S OPT=+Y
  1. Q $$ACCESS^XQCHK(USER,OPT)