ALPBGEN2 ;SFVAMC/JC - Init New Person Data on Workstations ;05/12/2003 07:40
;;3.0;BAR CODE MED ADMIN;**8,102**;Mar 2004;Build 14
;
; Reference/IA
; DEQUE^XUSERP/4511
;
INIT ;Initial Load
N DIR,DTOUT,DUOUT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
;Populate workstations with Vista New Person data
W !,"This option searches for users that hold the option, 'PSB GUI CONTEXT - USER'"
W !,"and if they are active users, transmits the information to your BCMA Backup Workstations."
W !,"NOTE that you must have completed the step of assigning workstations to either a"
W !,"single default group or by division."
W !!,"Do you wish to continue?" S DIR(0)="YA",DIR("B")="YES" D ^DIR
Q:Y<1!($D(DTOUT))!($D(DUOUT))
W !!,"Do you wish to queue this init?" S DIR(0)="YA",DIR("B")="YES" D ^DIR
Q:($D(DTOUT))!($D(DUOUT))
I Y D Q
. S ZTRTN="Q^ALPBGEN2",ZTDESC="BCBU New Person Init",ZTSAVE("*")="",ZTIO=""
. D ^%ZTLOAD I $D(ZTSK) W !,"TASK #: ",ZTSK
Q ;
N ALPBI,ALPBJ,ALPBK
S DTS=$$FMTE^XLFDT($$NOW^XLFDT)
S (ALPBK)=0,ALPBJ="" F S ALPBJ=$O(^VA(200,ALPBJ)) Q:ALPBJ="" D
. Q:+ALPBJ<1
. I $$ISBCMA(ALPBJ)>0 D
. . I '$D(ZTSK) W !,ALPBJ_" "_$P(^VA(200,ALPBJ,0),U)
. . D DEQUE^XUSERP(ALPBJ,1)
. . K HLA,HL
. . S ALPBK=$G(ALPBK)+1
K XQA,XQAMSG
S DTE=$$FMTE^XLFDT($$NOW^XLFDT)
S XQA(DUZ)=""
S XQAMSG="BCBU INIT Start:"_DTS_" Finish:"_DTE_". "_ALPBK_" users sent."
D SETUP^XQALERT
K DTS,DTE,ALPBK
Q
ISBCMA(USER) ;Does this person have BCMA access?
;Returns 0 if no such user
;user terminated or no access code
;no option in file
;no access due to locks
;Returns 1 if user has the PSB GUI CONTEXT - USER option
N OPT
S DIC="^DIC(19,",DIC(0)="MX",X="PSB GUI CONTEXT - USER"
D ^DIC K DIC,DA,DR
I +Y<1 Q 0
S OPT=+Y
Q $$ACCESS^XQCHK(USER,OPT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBGEN2 1805 printed Oct 16, 2024@17:40:14 Page 2
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
+2 ;
+3 ; Reference/IA
+4 ; DEQUE^XUSERP/4511
+5 ;
INIT ;Initial Load
+1 NEW DIR,DTOUT,DUOUT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+2 ;Populate workstations with Vista New Person data
+3 WRITE !,"This option searches for users that hold the option, 'PSB GUI CONTEXT - USER'"
+4 WRITE !,"and if they are active users, transmits the information to your BCMA Backup Workstations."
+5 WRITE !,"NOTE that you must have completed the step of assigning workstations to either a"
+6 WRITE !,"single default group or by division."
+7 WRITE !!,"Do you wish to continue?"
SET DIR(0)="YA"
SET DIR("B")="YES"
DO ^DIR
+8 if Y<1!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+9 WRITE !!,"Do you wish to queue this init?"
SET DIR(0)="YA"
SET DIR("B")="YES"
DO ^DIR
+10 if ($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+11 IF Y
Begin DoDot:1
+12 SET ZTRTN="Q^ALPBGEN2"
SET ZTDESC="BCBU New Person Init"
SET ZTSAVE("*")=""
SET ZTIO=""
+13 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"TASK #: ",ZTSK
End DoDot:1
QUIT
Q ;
+1 NEW ALPBI,ALPBJ,ALPBK
+2 SET DTS=$$FMTE^XLFDT($$NOW^XLFDT)
+3 SET (ALPBK)=0
SET ALPBJ=""
FOR
SET ALPBJ=$ORDER(^VA(200,ALPBJ))
if ALPBJ=""
QUIT
Begin DoDot:1
+4 if +ALPBJ<1
QUIT
+5 IF $$ISBCMA(ALPBJ)>0
Begin DoDot:2
+6 IF '$DATA(ZTSK)
WRITE !,ALPBJ_" "_$PIECE(^VA(200,ALPBJ,0),U)
+7 DO DEQUE^XUSERP(ALPBJ,1)
+8 KILL HLA,HL
+9 SET ALPBK=$GET(ALPBK)+1
End DoDot:2
End DoDot:1
+10 KILL XQA,XQAMSG
+11 SET DTE=$$FMTE^XLFDT($$NOW^XLFDT)
+12 SET XQA(DUZ)=""
+13 SET XQAMSG="BCBU INIT Start:"_DTS_" Finish:"_DTE_". "_ALPBK_" users sent."
+14 DO SETUP^XQALERT
+15 KILL DTS,DTE,ALPBK
+16 QUIT
ISBCMA(USER) ;Does this person have BCMA access?
+1 ;Returns 0 if no such user
+2 ;user terminated or no access code
+3 ;no option in file
+4 ;no access due to locks
+5 ;Returns 1 if user has the PSB GUI CONTEXT - USER option
+6 NEW OPT
+7 SET DIC="^DIC(19,"
SET DIC(0)="MX"
SET X="PSB GUI CONTEXT - USER"
+8 DO ^DIC
KILL DIC,DA,DR
+9 IF +Y<1
QUIT 0
+10 SET OPT=+Y
+11 QUIT $$ACCESS^XQCHK(USER,OPT)
