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

DG17203 ;BHM/RGY,ALS-Setup conversion files ;FEB 20, 1998
 ;;5.3;Registration;**172**;Aug 13, 1993
 Q
START ;
 NEW DIK,FILE,TYPE,LOCAL,IEN,DA,DR,DIE,POINTER,TEXT,X1,X2
 I '$O(^XTMP("DGTMP",390.1,0)) D  Q
 .;set purge date of XTMP = 30 days
 .S ^XTMP("DGTMP",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"RELIGION/MARITAL STATUS REINDEX"
 .W !,"Reindex Religion and Marital Status file xrefs ..."
 .K ^DIC(13,"B"),^DIC(11,"B"),^DIC(13,"C"),X
 .S DIK="^DIC(13,",DIK(1)=".01^B" D ENALL^DIK
 .S DIK="^DIC(13,",DIK(1)="3^C" D ENALL^DIK
 .S DIK="^DIC(11,",DIK(1)=".01^B" D ENALL^DIK
 .W !,"Setting up files that need to be converted..."
 .D CF^DG17201
 .;RENAME ENTRIES IN FILES HERE
 .W !,"Setting up standard/non-standard mapping file..."
 .F FILE=11,13 D
 ..K LOCAL,POINTER,TEXT
 ..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
 ..F IEN=0:0 S IEN=$O(^DIC(FILE,IEN)) Q:'IEN  D
 ...S ENT=$$ADD^DG17202(390.2)
 ...S TYPE=FILE,POINTER=IEN,STANDARD=$S($D(LOCAL($P(^DIC(FILE,IEN,0),"^"))):1,1:0)
 ...K LOCAL($P(^DIC(FILE,IEN,0),"^"))
 ...S DIE="^XTMP(""DGTMP"",390.2,",DR="[DG172 NEW "_$S(FILE=11:"MARITAL",1:"RELIGION")_"]",DA=ENT D ^DIE
 ...Q
 ..;ADD MISSING STANDARD ENTRIES
 ..S LOCAL="" F  S LOCAL=$O(LOCAL(LOCAL)) Q:LOCAL=""  D
 ...NEW N0 S N0=LOCAL(LOCAL)
 ...S NENT=$$ADDR^DG17202(FILE,$P(N0,"^"))
 ...S DA=NENT,DIE="^DIC("_FILE_",",DR=""
 ...I $P(N0,"^",2)]"" S DR="1////^S X="""_$P(N0,"^",2)_""""
 ...I $P(N0,"^",3)]"" S DR=DR_";2////^S X="""_$P(N0,"^",3)_""""
 ...I $P(N0,"^",4)]"" S DR=DR_";3////^S X="""_$P(N0,"^",4)_""""
 ...I DR]"" S:$E(DR)=";" DR=$E(DR,2,999) D ^DIE
 ...S ENT=$$ADD^DG17202(390.2),TYPE=FILE,POINTER=NENT,STANDARD=1,NEWSTAN=1
 ...S DIE="^XTMP(""DGTMP"",390.2,",DR="[DG172 NEW "_$S(FILE=11:"MARITAL",1:"RELIGION")_"]",DA=ENT D ^DIE
 ...K ENT,NENT,NEWSTAN,STANDARD
 ...Q
 ..Q
 .Q
 W !,"You can not re-start this process!"
 Q
RELIGION ;
 ;;JEWISH^^4^1
 ;;EASTERN ORTHODOX^^^2
 ;;BAPTIST^^^3
 ;;METHODIST^^^4
 ;;LUTHERAN^^2^5
 ;;PRESBYTERIAN^^^6
 ;;UNITED CHURCH OF CHRIST^^^7
 ;;EPISCOPALIAN^^^8
 ;;ADVENTIST^^^9
 ;;ASSEMBLY OF GOD^^^10
 ;;BRETHREN^^^11
 ;;CHRISTIAN SCIENTIST^^^12
 ;;CHURCH OF CHRIST^^^13
 ;;CHURCH OF GOD^^5^14
 ;;DISCIPLES OF CHRIST^^^15
 ;;EVANGELICAL COVENANT^^^16
 ;;FRIENDS^^^17
 ;;JEHOVAH'S WITNESS^^^18
 ;;LATTER-DAY SAINTS^LDS^^19
 ;;ISLAM^^^20
 ;;NAZARENE^^^21
 ;;OTHER^^^22
 ;;PENTECOSTAL^^^23
 ;;PROTESTANT, OTHER^^^24
 ;;PROTESTANT, NO DENOMINATION^^^25
 ;;REFORMED^^^26
 ;;SALVATION ARMY^^^27
 ;;UNITARIAN; UNIVERSALIST^^^28
 ;;UNKNOWN/NO PREFERENCE^^^29
 ;;CATHOLIC^^^0
 ;;NATIVE AMERICAN^^^30
 ;;BUDDHIST^^^31
 ;;
MARITAL ;
 ;;DIVORCED^^D
 ;;MARRIED^^M
 ;;WIDOW/WIDOWER^^W
 ;;SEPARATED^^S
 ;;NEVER MARRIED^^N
 ;;UNKNOWN^UNK^U
 ;;