- 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 Feb 18, 2025@23:05:45 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)