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