Changeset 636 for FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSERBLK.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSERBLK.m
r628 r636 1 XUSERBLK ;SF/RWF - Bulk user (new person) COMPUTER ACCESS ;02/26/2008 2 ;;8.0;KERNEL;**20,214,230,289,419,490**;Jul 10, 1995;Build 5 3 ; Per VHA Directive 2004-038, this routine should not be modified. 4 ; Option: XUSERBLK 1 XUSERBLK ;SF/RWF - Bulk user (new person) COMPUTER ACCESS ; 5/23/2006 2 ;;8.0;KERNEL;**20,214,230,289,419**;Jul 10, 1995;Build 5 5 3 ; This routine allows the Cloning of one person to a group of others. 6 4 A ; 7 5 I $G(DUZ)'>0 W !!,"You are not a known user and can't use this option." Q 8 N DIC, X,Y,XUTMP,DA,DIR,XUTERMDT,XUSER,XUY,%ZIS,XUIOP,XMQUIET6 N DIC,DIR,%,L,XUIOP,XUNODE,XU1,X1,X2,X3,X4,X5,X6,XUTEXT,XUNEW,XUSER,XUTMP,XUTERMDT,XUH,XUU,XUU2,M,P,XU 9 7 K ^TMP($J) 10 8 B1 W @IOF,!?26,"Batch Entry of New Persons" 11 9 W !?26,"--------------------------",!!,"Please select a person to copy from" 12 10 K DIC S DIC(0)="AEQZ",DIC("A")="Template PERSON: ",DIC="^VA(200," D ^DIC 13 Q:$D(DTOUT)!$D(DUOUT) 14 G B1:Y=-1 11 G QUIT:$D(DTOUT)!$D(DUOUT),B1:Y=-1 15 12 ; Show INFO to be copied" 16 13 S XUTMP=+Y,XUTMP(0)=$P(Y,U,2),DA=+Y D EN^DIQ 17 S DIR(0)="Y",DIR("A")="Is this the person whose data you want cloned" D ^DIR Q:$D(DIRUT) G B1:'Y 18 W !!,"You may enter a date, when the users that are being created/updated",!,"will no longer have access to the system." 19 S DIR(0)="DAO^DT::AEF" 20 S DIR("A")="Enter (optional) TERMINATION DATE: " 21 D ^DIR Q:$D(DTOUT)!$D(DUOUT) 22 S XUTERMDT=Y 14 S DIR(0)="Y",DIR("A")="Is this the person data you want cloned" D ^DIR G B1:'Y 15 W !,"You may enter a date, when the users that are being created/updated",!,"will no longer have access to the system." 16 S XUTERMDT="",%DT="AEF",%DT(0)=DT,%DT("A")="Enter (optional) TERMINATION DATE: " D ^%DT S:Y>0 XUTERMDT=Y 23 17 K XUSER S XUSER=0 24 18 B2 ; 25 19 W !!,?26,"Batch Entry of New Persons",!,?26,"--------------------------",! 26 W !,"Clone of: ",XUTMP(0) I XUTERMDT W ? 49,"TERMINATION DATE: ",$$FMTE^XLFDT(XUTERMDT)20 W !,"Clone of: ",XUTMP(0) I XUTERMDT W ?50,"TERMINATION DATE: ",$$FMTE^XLFDT(XUTERMDT) 27 21 ;; 28 22 B3 F S XUY=$$ADD^XUSERNEW Q:XUY<0 D ;Create new entry … … 35 29 . . S DIR(0)="Y",DIR("A")="Do You Want To Clone PERSON CLASS" D ^DIR 36 30 . . S:Y=1 $P(XUY,U,5)=1 37 . S:XUY>0 XUSER=XUSER+1,XUSER(XUSER)=XUY W ! !,"Next!"31 . S:XUY>0 XUSER=XUSER+1,XUSER(XUSER)=XUY W !,"Next!",! 38 32 . Q 39 33 B4 ; 40 Q:XUSER'>0 41 I XUTERMDT D 42 . N XUZT 43 . S XUZT("ZTDTH")=XUTERMDT 44 . W !!,"Queueing automatic deactivation for ",$$FMTE^XLFDT(XUTERMDT) 45 . S X=$$NODEV^XUTMDEVQ("CHECK^XUSTERM1",,,.XUZT,1) 46 W !!,"Where do you want to print the COMPUTER ACCOUNT NOTIFICATION LETTERS?" 47 S XMQUIET=1 48 S %ZIS="NMQ" D ^%ZIS Q:POP ; "N" means don't open device 49 K XMQUIET 50 S XUIOP=ION_";"_IOST_";"_IOM_";"_IOSL 51 D HOME^%ZIS 52 ;I ION["P-MESSAGE-HFS" G START 34 G:XUSER'>0 QUIT 35 I XUTERMDT>0 S ZTRTN="CHECK^XUSTERM1",ZTIO="",ZTDTH=XUTERMDT D ^%ZTLOAD W !,"Automatic deactivation has been queued for this date.",! 36 W !!,"Where do you want to print the COMPUTER ACCOUNT NOTIFICATION LETTERS" 37 S %ZIS="MQ" D ^%ZIS G QUIT:POP 38 I ION["P-MESSAGE-HFS" G START 53 39 I '$D(IO("Q")) G CLONE 54 40 START ; 55 N XUZT 56 S XUZT("ZTDTH")=$H 57 S X=$$NODEV^XUTMDEVQ("CLONE^XUSERBLK",,"XUIOP;XUTMP;XUTERMDT;XUSER;XUSER(",.XUZT,1) 41 S ZTRTN="CLONE^XUSERBLK" F I="XUTMP","XUTERMDT","XUSER","XUSER(" S ZTSAVE(I)="" 42 K IO("Q") D ^%ZTLOAD 43 ;; 44 QUIT ; 45 K DIC,DIR,%,L,XUIOP,XUNODE,XU1,X1,X2,X3,X4,X5,X6,XUTEXT,XUNEW,XUSER,XUTMP,XUTERMDT,XUH,XUU,XUU2,M,P,XU 46 K ^TMP($J) 58 47 Q 59 48 ;; 60 49 CLONE ;;Do work 61 N XUTEXT,XU1,%,DA,XUNEW,XUPURGE 62 S XUTEXT=$O(^DIC(9.2,"B",$$GET^XUPARAM("XUSER COMPUTER ACCOUNT","N"),0)) 50 S XUTEXT=$O(^DIC(9.2,"B",$$GET^XUPARAM("XUSER COMPUTER ACCOUNT","N"),0)),XUIOP=ION_";"_IOST_";"_IOM_";"_IOSL 63 51 F XU1=1:1:XUSER S %=XUSER(XU1),DA=+%,XUNEW=$P(%,U,3),XUPURGE=$P(%,U,4) D C2,UPDATE("ORD",DA) 64 K ^TMP($J)65 Q52 G QUIT 53 ; 66 54 C2 ; 67 N XU U,XUU2,XFDA,XUH,XUH2,XIEN,XERR,Y,XMZ,XMM,XMDT55 N XUH,XUH2,XUU,XUU2 68 56 I '$D(ZTQUEUED) W !!?8,$S(XUNEW:"CREATING A NEW ACCOUNT FOR '"_$P(XUSER(XU1),U,2)_"'",1:"CONVERTING "_$P(XUSER(XU1),U,2)_"'S ACCOUNT OVER"),!!,"One moment please..." 69 57 D BLDFDA … … 78 66 ; 79 67 BLDFDA ;Build the FDA 80 N X2,X3,X4,X5,X6,X7,XUNODE,XU81 68 S XFDA="^TMP($J,""XFDA"")",XIEN="^TMP($J,""XIEN"")" K ^TMP($J) 82 69 ;Move piece on nodes from list, Build XU only once … … 102 89 ; 103 90 ACODE ; 104 N Z105 91 F Z=0:0 S XUU=$$AC^XUS4(),XUH=$$EN^XUSHSH(XUU) Q:'($D(^VA(200,"AOLD",XUH))!$D(^VA(200,"A",XUH))) 106 92 Q … … 138 124 ; 139 125 LET(DA,XUTEXT) ;Write access letter 140 N DIWF,FR,TO,BY ,IOP126 N DIWF,FR,TO,BY 141 127 S DIWF="^DIC(9.2,"_XUTEXT_",1,",DIWF(1)=200,FR=DA,TO=DA,BY="NUMBER",IOP=XUIOP D EN2^DIWF 142 128 Q
Note:
See TracChangeset
for help on using the changeset viewer.