- DG17203 ;BHM/RGY,ALS-Setup conversion files ;FEB 20, 1998
- ;;5.3;Registration;**172,1015**;Aug 13, 1993;Build 21
- 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
- ;;
- DG17203 ;BHM/RGY,ALS-Setup conversion files ;FEB 20, 1998
- +1 ;;5.3;Registration;**172,1015**;Aug 13, 1993;Build 21
- +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 ;;
