source: IHS-VA_UTILITIES-XB/XBSANU.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
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.