source: IHS-VA_UTILITIES-XB/trunk/XBSANU.m@ 1076

Last change on this file since 1076 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 7.0 KB
Line 
1XBSANU ;IHS/ITSC/LAB/FJE;SANITIZE RPMS DATABASE; [ 01/29/2005 11:10 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 W !,"This routine sanitizes and deletes RPMS New Person file data. To use you must type: D START^XBSANU"
4 W !,"For help and an explanation of this utility type D HELP^XBSANU",!!
5 Q
6START ;
7 S (XBDUZ,XBDEL,XBPAT,XBPHR,XBBH,XBCHR,XBPOS,XB3PB,XBAR,XBLAB,XBMMDEL,XBAUDEL,XBNCDEL)=0
8 K ^XTMP("SAN")
9 S ^XTMP("SAN","LASTDFN")=0
10 W !,"This routine will sanitize AND randomize the NEW PERSON file in the RPMS database."
11 S DIR(0)="Y",DIR("A")="Do you want to convert the new person data?",DIR("B")="N" KILL DA D ^DIR KILL DIR
12 S:Y=1 XBDUZ=1
13 W !,"All failed fileman update data can be found in: ^XTMP(""SAN"",""DUZFAILURE"", GLOBAL"
14 W !,"?? display usually means that there was a fileman update failure"
15 W !,"If a hard error like an UNDEFINED occurs during the scrambling,"
16 W !," you can restart at the next patient by typing: RESTART^XBSANU "
17 W !,"When finished...don't forget to manually address the failures"
18 W !,"D LIST^XBSANU will list the errors",!!
19 W !!,"This routine is about to scramble the RPMS database."
20 S DIR(0)="Y",DIR("A")="Last chance: Do you want your RPMS NEW PERSON file data SANITIZED?",DIR("B")="N" KILL DA D ^DIR KILL DIR
21 Q:Y'=1
22 D ^XBKVAR
23 W !,"Collecting random names" D CLEAN
24FJE ;
25 I XBDUZ W !,"SCRAMBLING FILE 200" D DUZ
26 S ^XTMP("SAN","DUZPROCESS","XBSAN")="FINISHED"
27 W !,"FINISHED"
28 D LIST
29 D EOJ
30 Q
31 ;
32EOJ ;
33 D EN^XBVK("XB")
34 K DFN,XBH,OTDFN,XBB,AUPNSEX,X,X2,XB3PB,XBAR,XBAUDEL
35 K DA,DIE,DIK,DIR,DR,XBDUZSSN,I,XBA,XBADDR,XBADL1
36 K XBBH,XBC,XBCHART,XBCHR,XBD,XBDAD,XBDEANUM,XBDEL,XBDFIRST,XBDLAST,XBDNAME
37 K XBDOB,XBDUZ,XBFIRST,XBFNAME,XBH,XBLAB,XBLNAME,XBMDFN,XBMMDEL,XBMOM
38 K XBNAME,XBNCDEL,XBNOK,XBNOKADL,XBP,XBPAT,XBPHN,XBPHR,XBPOS,XBS
39 K XBSCR,XBSEX,XBSSN,XBTEN,XBVAL,XBVANUM,XBX,Y,Z
40 W !,"If all data appears correct and you have chaecked failures, kill the ^XTMP(""SAN"") global",!!
41 Q
42 ;
43CLEAN ;
44 K ^XTMP("SAN","DLAST")
45 K ^XTMP("SAN","DFIRST")
46 K ^XTMP("SAN","PROCESS","DUZ")
47 K ^XTMP("SAN","DUZFAILURE")
48 D ^XBKVAR
49 S (XBC(1),XBC(2))=0,XBX=1 F S XBX=$O(^VA(200,XBX)) Q:+XBX=0 D
50 .S XBNAME=$P($G(^VA(200,XBX,0)),U,1)
51 .S XBLAST=$P(XBNAME,",",1) S:'$L(XBLAST) XBLAST="MOUSE" S:$L(XBLAST)<3 XBLAST=XBLAST_"AAA"
52 .S XBFIRST=$P(XBNAME,",",2) S:'$L(XBFIRST) XBFIRST="MICKEY"_+XBX
53 .S XBC(1)=XBC(1)+1,^XTMP("SAN","DLAST")=XBC(1),^XTMP("SAN","DLAST",XBC(1))=XBLAST
54 .S XBC(2)=XBC(2)+1,^XTMP("SAN","DFIRST")=XBC(2),^XTMP("SAN","DFIRST",XBC(2))=XBFIRST
55 Q
56R S X2=$R(X) I X2=0 G R
57 S X=X2
58 Q
59 ;
60DUZ ;SCRAMBLES USER NAMES
61 D ^XBFMK
62 I '$D(^XTMP("SAN","LASTDUZ")) S ^XTMP("SAN","LASTDUZ")=1
63 S XBX=+^XTMP("SAN","LASTDUZ")
64 F S XBX=$O(^VA(200,XBX)) Q:+XBX=0 D
65 .S DA=XBX,DIE=200,DR="53.2///@" D ^DIE I $D(Y) S ^XTMP("SAN","DUZFAILURE","DUZDEA",XBX)=""
66 .D ^XBFMK
67RESTART ;RESTARTS IF HARD FAILURE WITH DUZ (COMMON BECAUSE OF 3,6,16 PROBLEMS)
68 S XBX=+^XTMP("SAN","LASTDUZ")
69 F S XBX=$O(^VA(200,XBX)) Q:+XBX=0 D
70 .S ^XTMP("SAN","LASTDUZ")=XBX
71 .S X=^XTMP("SAN","DLAST") D R S XBLAST=^XTMP("SAN","DLAST",X)
72 .S X=^XTMP("SAN","DFIRST") D R S XBFIRST=^XTMP("SAN","DFIRST",X)
73 .D DUZSSN
74 .I XBDUZSSN S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST_";9///"_XBDUZSSN D ^DIE I $D(Y) S ^XTMP("SAN","DUZFAILURE","DUZ IEN FAILURE",XBX)=""
75 .I 'XBDUZSSN S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST D ^DIE I $D(Y) S ^XTMP("SAN","DUZFAILURE","DUZ IEN FAILURE",XBX)=""
76 .S DA=XBX,DIE=200,DR="1///"_$E(XBLAST,1,3)_";13///"_$E(XBLAST,1,8) D ^DIE I $D(Y) S ^XTMP("SAN","DUZFAILURE","DUZINITIALS",XBX)=""
77 .S XBVANUM=1000000+XBX
78 .S XBDEANUM=200000+XBX
79 .S XBDEAIL=$E(XBLAST,1)
80 .S XBDEAN=$E(XBDEANUM,1)+$E(XBDEANUM,3)+$E(XBDEANUM,5)+(2*($E(XBDEANUM,2)+$E(XBDEANUM,4)+$E(XBDEANUM,6)))
81 .S XBDEAN=XBDEAN#10
82 .S XBDEA="A"_XBDEAIL_XBDEANUM_XBDEAN
83 .S DA=XBX,DIE=200,DR="53.2///"_XBDEA D ^DIE I $D(Y) S ^XTMP("SAN","DUZFAILURE","DUZDEA",XBX)=""
84 .D ^XBFMK
85 .S DA=XBX,DIE=200,DR="53.3///"_XBVANUM D ^DIE I $D(Y) S ^XTMP("SAN","DUZFAILURE","DUZVA",XBX)=""
86 .D ^XBFMK
87 S ^XTMP("SAN","DUZPROCESS","DUZ")="FINISHED"
88 Q
89DUZSSN ;CHANGES SSN FOR USER FILE
90 S XBDUZSSN=$P($G(^VA(200,XBX,1)),"^",9)
91 I XBDUZSSN D DUZSSNR S XBDUZSSN=XBSSN
92 Q
93DUZSSNR ;FIND RANDOM SSN
94 F S XBSSN=$R(999999999) Q:XBSSN>100000000&(XBSSN<800000000)
95 I $D(^VA(200,"SSN",XBSSN)) G DUZSSNR
96 Q
97ALLSSN ;ADDS SSN TO EVERY DUZ
98 D ^XBFMK
99 S XBX=0 F S XBX=$O(^VA(200,XBX)) Q:+XBX=0 D
100 .Q:$L($P($G(^VA(200,XBX,0)),"^",9))
101 .D SSNR
102 .S DA=XBX,DIE=200,DR=".09///"_XBSSN D ^DIE K DIE,DA
103 .D ^XBFMK
104 S ^XTMP("SAN","DUZPROCESS","DUZ SSN-ALL")="FINISHED"
105 Q
106SSNR ;FIND RANDOM SSN
107 F S XBSSN=$R(999999999) Q:XBSSN>100000000&(XBSSN<800000000)
108 I $D(^VA(200,"SSN",XBSSN)) G SSNR
109 Q
110 ;
111LIST ;
112 W !,"Listed below are the nodes and number of records that did not"
113 W !,"update properly."
114 W !,"XTMP(""SAN"",""DUZFAILURE"") nodes:"
115 S X="" F S X=$O(^XTMP("SAN","DUZFAILURE",X)) Q:X="" D
116 .S (Y,Z)=0 F S Y=$O(^XTMP("SAN","DUZFAILURE",X,Y)) Q:+Y=0 D
117 ..S Z=Z+1
118 .W !,"Failure: "_X_" "_Z
119 W !,"FINISHED"
120LISTD ;
121 W !,"Listed below are the processes completed."
122 W !,"XTMP(""SAN"",""PROCESS"") nodes:"
123 S X="" F S X=$O(^XTMP("SAN","PROCESS",X)) Q:X="" D
124 .W !,"Process: "_X
125 W !,"FINISHED" Q
126STU ;SETS STUDENT NAMES
127 K ^XTMP("SAN","DUZFAILURE","STU")
128 K ^XTMP("SAN","DUZFAILURE","STUA")
129STUA D ^XBFMK
130 S XBX=50 F S XBX=$O(^VA(200,XBX)) Q:+XBX>76 D
131 .S XBLAST=$E("ABCDEFGHIJKLMNOPQRSTUVWXYZ",XBX-50,XBX-50)_"STUDENT"
132 .S XBFIRST="USER"
133 .S DA=XBX,DIE=200,DR=".01///"_XBLAST_","_XBFIRST D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STU",XBX)=""
134 .S DA=XBX,DIE=200,DR="1///"_$E(XBLAST,1,2)_"U;13///"_$E(XBLAST,1,8) D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STUINITIALS",XBX)=""
135 .S DA=XBX,DIE=200,DR="201///`29" D ^DIE I $D(Y) S ^XTMP("SAN","FAILURE","STUMENU",XBX)=""
136 .D ^XBFMK
137 W !,"FINISHED"
138 Q
139HELP ;
140 W !,"Notes for sanitizing file 200."
141 W !,"START^XBSANU will start the sanitizing. The last names and first names"
142 W !,"of file 200 are captured and then randomly combined to form a new name"
143 W !,"If the user has a SSN regestered then that number is also ramdomized."
144 W !,"The internal entry is added to 1000000 to create the VA number and"
145 W !,"2000000 is added to make the DEA number"
146 W !,"The first three letters of the last name make up the initials and"
147 W !,"the first eight characters of the last name make up the nick name."
148 W !,"To fix hard errors you should look at the following:"
149 W !,"File 200 (^VA(200,IEN,0)) piece 16 points to file 16 (^DIC(16)). If"
150 W !,"^DIC(16,pointer,0) does not exist, you will get a hard error. File 16"
151 W !,"and file 6 (^DIC(6)) are generally dinumed and in file 16 the "
152 W !,"^DIC(16,pointer,""A6"" and ""A3"" point to file 6 and 3 (^DIC(3))"
153 W !,"respectfully. If either is missing you will get an error. File 3's IEN"
154 W !,"generally is dinumed to file 200.",!!
155 W !,"You can run this utility over and over without problems. The result is"
156 W !,"randomized again. User IEN 1 remains as ADAM,ADAM and is unchanged"
157 W !,"LIST^XBSANU will list the errors found"
158 W !,"ALLSSN^XBSANU will add a random SSN to all file 200 users"
159 W !,"STU^XBSANU will create 26 student accounts starting with ASTUDENT,USER"
160 W !,"and ending with ZSTUDENT,USER for IENS 51-76."
161 Q
Note: See TracBrowser for help on using the repository browser.