DG53P782 ;ALB/RC-UPDATE FOR FILE 13 ; 5/15/08 11:56am
;;5.3;Registration;**782**;Aug 13, 1993;Build 8
Q
EN ;Post install entry point
;create KIDS checkpoints with call backs
N DGX,Y
F DGX="POST" D
. S Y=$$NEWCP^XPDUTL(DGX,DGX+"DG53P782")
. I 'Y D BMES^XPDUTL("ERROR creating "_DGX_" checkpoint.")
Q
POST ;Post Install
D UP^DG53P782 ;Update Religion Entries.
D ADD^DG53P782 ;Add Religion Entries.
Q
UP N DA,DIE,DR
N DGCNT,X,OLDTEXT,NEWTEXT,UPDENTRY
D BMES^XPDUTL("Updating religions")
F DGCNT=1:1 S UPDENTRY=$P($T(UPDTABLE+DGCNT),";;",2) Q:UPDENTRY="EXIT" D
.S OLDTEXT=$P(UPDENTRY,"^",1),NEWTEXT=$P(UPDENTRY,"^",2)
.S DA=$O(^DIC(13,"B",OLDTEXT,0))
.S DIE=13,DR=".01///^S X=NEWTEXT"
.D
..I DA D ^DIE Q
..D BMES^XPDUTL(OLDTEXT_" does not exist or has already been updated.")
Q
ADD ;Add entries to the religion file
N DGCNT,X,NEWENTRY,NEWCODE,NEWREL,RELCHECK
D BMES^XPDUTL("Adding Religions")
F DGCNT=1:1 S NEWENTRY=$P($T(NEWTABLE+DGCNT),";;",2) Q:NEWENTRY="EXIT" D
.S NEWREL=$P(NEWENTRY,"^",1),NEWCODE=$P(NEWENTRY,"^",2)
.;Don't add the religion if it already exists.
.S RELCHECK=$O(^DIC(13,"B",NEWREL,0)) D
..I RELCHECK D BMES^XPDUTL(NEWREL_" already exists.") Q
..N DA,DIC,DLAYGO
..S DIC="^DIC(13,",DIC(0)="L",DLAYGO=13
..S X=NEWREL,DIC("DR")="3///^S X=NEWCODE"
..K DD,D0 D FILE^DICN K DIC,DA,DLAYGO
Q
UPDTABLE ;Table of religions being updated.
;;BUDDHIST^ZEN BUDDHISM
;;CATHOLIC^ROMAN CATHOLIC CHURCH
;;JEHOVAH'S WITNESS^JEHOVAH'S WITNESSES
;;JEWISH^JUDAISM
;;LATTER-DAY SAINTS^LATTER DAY SAINTS
;;PROTESTANT, OTHER^PROTESTANT
;;UNITARIAN; UNIVERSALIST^UNITARIAN-UNIVERSALISM
;;EXIT
NEWTABLE ;Table of religions being added.
;;AFRICAN RELIGIONS^32
;;AFRO-CARIBBEAN RELIGIONS^33
;;AGNOSTICISM^34
;;ANGLICAN^35
;;ANIMISM^36
;;ATHEISM^37
;;BABI & BAHA'I FAITHS^38
;;BON^39
;;CAO DAI^40
;;CELTICISM^41
;;CHRISTIAN (NON-SPECIFIC)^42
;;CONFUCIANISM^43
;;CONGREGATIONAL^44
;;CYBERCULTURE RELIGIONS^45
;;DIVINATION^46
;;FOURTH WAY^47
;;FREE DAISM^48
;;FULL GOSPEL^49
;;GNOSIS^50
;;HINDUISM^51
;;HUMANISM^52
;;INDEPENDENT^53
;;JAINISM^54
;;MAHAYANA^55
;;MEDITATION^56
;;MESSIANIC JUDAISM^57
;;MITRAISM^58
;;NEW AGE^59
;;NON-ROMAN CATHOLIC^60
;;OCCULT^61
;;ORTHODOX^62
;;PAGANISM^63
;;PROCESS, THE^64
;;REFORMED/PRESBYTERIAN^65
;;SATANISM^66
;;SCIENTOLOGY^67
;;SHAMANISM^68
;;SHIITE (ISLAM)^69
;;SHINTO^70
;;SIKISM^71
;;SPIRITUALISM^72
;;SUNNI (ISLAM)^73
;;TAOISM^74
;;THERAVADA^75
;;UNIVERSAL LIFE CHURCH^76
;;VAJRAYANA (TIBETAN)^77
;;VEDA^78
;;VOODOO^79
;;WICCA^80
;;YAOHUSHUA^81
;;ZOROASTRIANISM^82
;;ASKED BUT DECLINED TO ANSWER^83
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53P782 2732 printed Oct 16, 2024@18:40:47 Page 2
DG53P782 ;ALB/RC-UPDATE FOR FILE 13 ; 5/15/08 11:56am
+1 ;;5.3;Registration;**782**;Aug 13, 1993;Build 8
+2 QUIT
EN ;Post install entry point
+1 ;create KIDS checkpoints with call backs
+2 NEW DGX,Y
+3 FOR DGX="POST"
Begin DoDot:1
+4 SET Y=$$NEWCP^XPDUTL(DGX,DGX+"DG53P782")
+5 IF 'Y
DO BMES^XPDUTL("ERROR creating "_DGX_" checkpoint.")
End DoDot:1
+6 QUIT
POST ;Post Install
+1 ;Update Religion Entries.
DO UP^DG53P782
+2 ;Add Religion Entries.
DO ADD^DG53P782
+3 QUIT
UP NEW DA,DIE,DR
+1 NEW DGCNT,X,OLDTEXT,NEWTEXT,UPDENTRY
+2 DO BMES^XPDUTL("Updating religions")
+3 FOR DGCNT=1:1
SET UPDENTRY=$PIECE($TEXT(UPDTABLE+DGCNT),";;",2)
if UPDENTRY="EXIT"
QUIT
Begin DoDot:1
+4 SET OLDTEXT=$PIECE(UPDENTRY,"^",1)
SET NEWTEXT=$PIECE(UPDENTRY,"^",2)
+5 SET DA=$ORDER(^DIC(13,"B",OLDTEXT,0))
+6 SET DIE=13
SET DR=".01///^S X=NEWTEXT"
+7 Begin DoDot:2
+8 IF DA
DO ^DIE
QUIT
+9 DO BMES^XPDUTL(OLDTEXT_" does not exist or has already been updated.")
End DoDot:2
End DoDot:1
+10 QUIT
ADD ;Add entries to the religion file
+1 NEW DGCNT,X,NEWENTRY,NEWCODE,NEWREL,RELCHECK
+2 DO BMES^XPDUTL("Adding Religions")
+3 FOR DGCNT=1:1
SET NEWENTRY=$PIECE($TEXT(NEWTABLE+DGCNT),";;",2)
if NEWENTRY="EXIT"
QUIT
Begin DoDot:1
+4 SET NEWREL=$PIECE(NEWENTRY,"^",1)
SET NEWCODE=$PIECE(NEWENTRY,"^",2)
+5 ;Don't add the religion if it already exists.
+6 SET RELCHECK=$ORDER(^DIC(13,"B",NEWREL,0))
Begin DoDot:2
+7 IF RELCHECK
DO BMES^XPDUTL(NEWREL_" already exists.")
QUIT
+8 NEW DA,DIC,DLAYGO
+9 SET DIC="^DIC(13,"
SET DIC(0)="L"
SET DLAYGO=13
+10 SET X=NEWREL
SET DIC("DR")="3///^S X=NEWCODE"
+11 KILL DD,D0
DO FILE^DICN
KILL DIC,DA,DLAYGO
End DoDot:2
End DoDot:1
+12 QUIT
UPDTABLE ;Table of religions being updated.
+1 ;;BUDDHIST^ZEN BUDDHISM
+2 ;;CATHOLIC^ROMAN CATHOLIC CHURCH
+3 ;;JEHOVAH'S WITNESS^JEHOVAH'S WITNESSES
+4 ;;JEWISH^JUDAISM
+5 ;;LATTER-DAY SAINTS^LATTER DAY SAINTS
+6 ;;PROTESTANT, OTHER^PROTESTANT
+7 ;;UNITARIAN; UNIVERSALIST^UNITARIAN-UNIVERSALISM
+8 ;;EXIT
NEWTABLE ;Table of religions being added.
+1 ;;AFRICAN RELIGIONS^32
+2 ;;AFRO-CARIBBEAN RELIGIONS^33
+3 ;;AGNOSTICISM^34
+4 ;;ANGLICAN^35
+5 ;;ANIMISM^36
+6 ;;ATHEISM^37
+7 ;;BABI & BAHA'I FAITHS^38
+8 ;;BON^39
+9 ;;CAO DAI^40
+10 ;;CELTICISM^41
+11 ;;CHRISTIAN (NON-SPECIFIC)^42
+12 ;;CONFUCIANISM^43
+13 ;;CONGREGATIONAL^44
+14 ;;CYBERCULTURE RELIGIONS^45
+15 ;;DIVINATION^46
+16 ;;FOURTH WAY^47
+17 ;;FREE DAISM^48
+18 ;;FULL GOSPEL^49
+19 ;;GNOSIS^50
+20 ;;HINDUISM^51
+21 ;;HUMANISM^52
+22 ;;INDEPENDENT^53
+23 ;;JAINISM^54
+24 ;;MAHAYANA^55
+25 ;;MEDITATION^56
+26 ;;MESSIANIC JUDAISM^57
+27 ;;MITRAISM^58
+28 ;;NEW AGE^59
+29 ;;NON-ROMAN CATHOLIC^60
+30 ;;OCCULT^61
+31 ;;ORTHODOX^62
+32 ;;PAGANISM^63
+33 ;;PROCESS, THE^64
+34 ;;REFORMED/PRESBYTERIAN^65
+35 ;;SATANISM^66
+36 ;;SCIENTOLOGY^67
+37 ;;SHAMANISM^68
+38 ;;SHIITE (ISLAM)^69
+39 ;;SHINTO^70
+40 ;;SIKISM^71
+41 ;;SPIRITUALISM^72
+42 ;;SUNNI (ISLAM)^73
+43 ;;TAOISM^74
+44 ;;THERAVADA^75
+45 ;;UNIVERSAL LIFE CHURCH^76
+46 ;;VAJRAYANA (TIBETAN)^77
+47 ;;VEDA^78
+48 ;;VOODOO^79
+49 ;;WICCA^80
+50 ;;YAOHUSHUA^81
+51 ;;ZOROASTRIANISM^82
+52 ;;ASKED BUT DECLINED TO ANSWER^83
+53 ;;EXIT
