source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG17203.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1DG17203 ;BHM/RGY,ALS-Setup conversion files ;FEB 20, 1998
2 ;;5.3;Registration;**172**;Aug 13, 1993
3 Q
4START ;
5 NEW DIK,FILE,TYPE,LOCAL,IEN,DA,DR,DIE,POINTER,TEXT,X1,X2
6 I '$O(^XTMP("DGTMP",390.1,0)) D Q
7 .;set purge date of XTMP = 30 days
8 .S ^XTMP("DGTMP",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"RELIGION/MARITAL STATUS REINDEX"
9 .W !,"Reindex Religion and Marital Status file xrefs ..."
10 .K ^DIC(13,"B"),^DIC(11,"B"),^DIC(13,"C"),X
11 .S DIK="^DIC(13,",DIK(1)=".01^B" D ENALL^DIK
12 .S DIK="^DIC(13,",DIK(1)="3^C" D ENALL^DIK
13 .S DIK="^DIC(11,",DIK(1)=".01^B" D ENALL^DIK
14 .W !,"Setting up files that need to be converted..."
15 .D CF^DG17201
16 .;RENAME ENTRIES IN FILES HERE
17 .W !,"Setting up standard/non-standard mapping file..."
18 .F FILE=11,13 D
19 ..K LOCAL,POINTER,TEXT
20 ..F X=1:1 S TEXT=$P($S(FILE=11:$T(MARITAL+X),1:$T(RELIGION+X)),";;",2) Q:TEXT="" S LOCAL($P(TEXT,"^"))=TEXT
21 ..F IEN=0:0 S IEN=$O(^DIC(FILE,IEN)) Q:'IEN D
22 ...S ENT=$$ADD^DG17202(390.2)
23 ...S TYPE=FILE,POINTER=IEN,STANDARD=$S($D(LOCAL($P(^DIC(FILE,IEN,0),"^"))):1,1:0)
24 ...K LOCAL($P(^DIC(FILE,IEN,0),"^"))
25 ...S DIE="^XTMP(""DGTMP"",390.2,",DR="[DG172 NEW "_$S(FILE=11:"MARITAL",1:"RELIGION")_"]",DA=ENT D ^DIE
26 ...Q
27 ..;ADD MISSING STANDARD ENTRIES
28 ..S LOCAL="" F S LOCAL=$O(LOCAL(LOCAL)) Q:LOCAL="" D
29 ...NEW N0 S N0=LOCAL(LOCAL)
30 ...S NENT=$$ADDR^DG17202(FILE,$P(N0,"^"))
31 ...S DA=NENT,DIE="^DIC("_FILE_",",DR=""
32 ...I $P(N0,"^",2)]"" S DR="1////^S X="""_$P(N0,"^",2)_""""
33 ...I $P(N0,"^",3)]"" S DR=DR_";2////^S X="""_$P(N0,"^",3)_""""
34 ...I $P(N0,"^",4)]"" S DR=DR_";3////^S X="""_$P(N0,"^",4)_""""
35 ...I DR]"" S:$E(DR)=";" DR=$E(DR,2,999) D ^DIE
36 ...S ENT=$$ADD^DG17202(390.2),TYPE=FILE,POINTER=NENT,STANDARD=1,NEWSTAN=1
37 ...S DIE="^XTMP(""DGTMP"",390.2,",DR="[DG172 NEW "_$S(FILE=11:"MARITAL",1:"RELIGION")_"]",DA=ENT D ^DIE
38 ...K ENT,NENT,NEWSTAN,STANDARD
39 ...Q
40 ..Q
41 .Q
42 W !,"You can not re-start this process!"
43 Q
44RELIGION ;
45 ;;JEWISH^^4^1
46 ;;EASTERN ORTHODOX^^^2
47 ;;BAPTIST^^^3
48 ;;METHODIST^^^4
49 ;;LUTHERAN^^2^5
50 ;;PRESBYTERIAN^^^6
51 ;;UNITED CHURCH OF CHRIST^^^7
52 ;;EPISCOPALIAN^^^8
53 ;;ADVENTIST^^^9
54 ;;ASSEMBLY OF GOD^^^10
55 ;;BRETHREN^^^11
56 ;;CHRISTIAN SCIENTIST^^^12
57 ;;CHURCH OF CHRIST^^^13
58 ;;CHURCH OF GOD^^5^14
59 ;;DISCIPLES OF CHRIST^^^15
60 ;;EVANGELICAL COVENANT^^^16
61 ;;FRIENDS^^^17
62 ;;JEHOVAH'S WITNESS^^^18
63 ;;LATTER-DAY SAINTS^LDS^^19
64 ;;ISLAM^^^20
65 ;;NAZARENE^^^21
66 ;;OTHER^^^22
67 ;;PENTECOSTAL^^^23
68 ;;PROTESTANT, OTHER^^^24
69 ;;PROTESTANT, NO DENOMINATION^^^25
70 ;;REFORMED^^^26
71 ;;SALVATION ARMY^^^27
72 ;;UNITARIAN; UNIVERSALIST^^^28
73 ;;UNKNOWN/NO PREFERENCE^^^29
74 ;;CATHOLIC^^^0
75 ;;NATIVE AMERICAN^^^30
76 ;;BUDDHIST^^^31
77 ;;
78MARITAL ;
79 ;;DIVORCED^^D
80 ;;MARRIED^^M
81 ;;WIDOW/WIDOWER^^W
82 ;;SEPARATED^^S
83 ;;NEVER MARRIED^^N
84 ;;UNKNOWN^UNK^U
85 ;;
Note: See TracBrowser for help on using the repository browser.