MDPOST16 ;HINES OIFO/DP - Post Installation Tasks;02 Mar 2008
;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine uses the following IAs:
; # 2263 - XPAR calls TOOLKIT (supported)
; # 4447 - POSTKID^VDEFVU VDEF (controlled subscription)
; #10141 - MES^XPDUTL Kernel (supported)
;
EN ; Post installation tasks to bring Legacy CP up to snuff
;
N MDTMP,MDTASK,MDX,MDCMD,MDTXT,MDVER,MDBUILD
S MDBUILD=$P($P($T(+2),";",7)," ",2)
;
; Import the new data
;
D IMPORT
;
; Remove obsolete parameters of where updates are located
;
D MES^XPDUTL(" Removing obsolete parameters ...")
D EN^XPAR("SYS","MD PARAMETERS","UPDATE_MASTER","@")
D EN^XPAR("SYS","MD PARAMETERS","UPDATE_FRAMEWORK","@")
D EN^XPAR("SYS","MD PARAMETERS","UPDATE_SOURCE","@")
;
; Remove old, unused routines. BLJ 17 March 2010
N X F X="MDCORE","MDCPST" X ^%ZOSF("DEL")
K X
;
; Update the queued jobs list
;
; load all pars into MDTASK() and then remove the XPAR copy of each TASK_*
;
D MES^XPDUTL(" Updating queued job settings ...")
D GETLST^XPAR(.MDTMP,"SYS","MD PARAMETERS","Q")
F MDX=0:0 S MDX=$O(MDTMP(MDX)) Q:'MDX D:MDTMP(MDX)?1"TASK_".E
.S MDTASK($P(MDTMP(MDX),"^",1))=$P(MDTMP(MDX),"^",2)
.D EN^XPAR("SYS","MD PARAMETERS",$P(MDTMP(MDX),"^",1),"@")
;
; Now rebuild the ones that we want to keep
;
F X="TASK_CLIO_CLEANUP","TASK_CP_CLEANUP","TASK_HL7_CLEANUP" D
.S MDTASK(X)=$G(MDTASK(X),"0;;;0")
;
S $P(MDTASK("TASK_CLIO_CLEANUP"),";",2)="CliO Cleanup"
S $P(MDTASK("TASK_CLIO_CLEANUP"),";",3)="CLIO MDCPURG"
;
S $P(MDTASK("TASK_CP_CLEANUP"),";",2)="CP Cleanup"
S $P(MDTASK("TASK_CP_CLEANUP"),";",3)="CP MDCPURG"
;
S $P(MDTASK("TASK_HL7_CLEANUP"),";",2)="HL7 Cleanup"
S $P(MDTASK("TASK_HL7_CLEANUP"),";",3)="HL7 MDCPURG"
;
; Save them back to XPAR
;
F MDX="TASK_CLIO_CLEANUP","TASK_CP_CLEANUP","TASK_HL7_CLEANUP" D
.D EN^XPAR("SYS","MD PARAMETERS",MDX,MDTASK(MDX))
.D MES^XPDUTL(" Task '"_MDX_"' updated...")
;
; Set the required build numbers for the applications (1.0.16.BUILD)
;
F MDX="CPFLOWSHEETS","CPCONSOLE","CPGATEWAYSERVICE" D
.D EN^XPAR("SYS","MD PARAMETERS","VERSION_"_MDX,"1.0.16."_MDBUILD)
;
; Update the CP DEFINITION File with GUIDS and Active Status
D MES^XPDUTL(" Updating CP Definition File...")
N MDX,MDY,MDFDA,MDIEN,MDFILE
F MDX=0:0 S MDX=$O(^MDS(702.01,MDX)) Q:'MDX D
.I $P($G(^MDS(702.01,MDX,"ID")),U)'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}" D
..F D GETGUID^MDCLIO1(.MDY) Q:'$D(^MDS(702.01,"PK",MDY))
..S MDFDA(702.01,MDX_",",.13)=MDY
.S MDFDA(702.01,MDX_",",.09)=1
.D FILE^DIE("","MDFDA")
;
; Clear cache settings to force new build
D EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_CACHE_SETTINGS","@")
D MES^XPDUTL(" Terminology Caching disabled, use CP Console to rebuild.")
;
; Update the CP INSTRUMENT File with GUIDS and Active Status
D MES^XPDUTL(" Updating CP Instrument File...")
F MDX=0:0 S MDX=$O(^MDS(702.09,MDX)) Q:'MDX D
.I $P($G(^MDS(702.09,MDX,"ID")),U)'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}" D
..F D GETGUID^MDCLIO1(.MDY) Q:'$D(^MDS(702.09,"PK",MDY))
..S MDFDA(702.09,MDX_",",.1)=MDY
.S MDFDA(702.09,MDX_",",.09)=1
.D FILE^DIE("","MDFDA")
;
; Add any needed VDEF entries
;
; IA 4447.
;
; Event subtypes:
; CPAN - CLIO Admit/Visit Notification (A01)
; CPCAN - CLIO Cancel Admit Notice (A11)
; CPCDE - CLIO Cancel Discharge (A13)
; CPCT - CLIO Cancel Transfer (A12)
; CPDE - CLIO Discharge/End Visit (A03)
; CPTP - CLIO Transfer a Patient (A02)
; CPUPI - CLIO Update Patient Info (A08)
;
; Message/Event types - Protocols - Extraction Program
; ADT/A01 - MDC CPAN VS - MDCA01
; ADT/A02 - MDC CPTP VS - MDCA02
; ADT/A03 - MDC CPDE VS - MDCA03
; ADT/A08 - MDC CPUPI VS - MDCA08
; ADT/A11 - MDC CPCAN VS - MDCA11
; ADT/A12 - MDC CPCT VS - MDCA12
; ADT/A13 - MDC CPCDE VS - MDCA13
;
D POSTKID^VDEFVU("ADT","A01","CPAN","MDC CPAN VS","CLINICAL PROCEDURES","MDCA01","CLIO Admit/Visit Notification (A01)","CLIO Admit/Visit Notification (A01)")
D POSTKID^VDEFVU("ADT","A02","CPTP","MDC CPTP VS","CLINICAL PROCEDURES","MDCA02","CLIO Transfer a Patient (A02)","CLIO Transfer a Patient (A02)")
D POSTKID^VDEFVU("ADT","A03","CPDE","MDC CPDE VS","CLINICAL PROCEDURES","MDCA03","CLIO Discharge/End Visit (A03)","CLIO Discharge/End Visit (A03)")
D POSTKID^VDEFVU("ADT","A08","CPUPI","MDC CPUPI VS","CLINICAL PROCEDURES","MDCA08","CLIO Update Patient Info (A08)","CLIO Update Patient Info (A08)")
D POSTKID^VDEFVU("ADT","A11","CPCAN","MDC CPCAN VS","CLINICAL PROCEDURES","MDCA11","CLIO Cancel Admit Notice (A11)","CLIO Cancel Admit Notice (A11)")
D POSTKID^VDEFVU("ADT","A12","CPCT","MDC CPCT VS","CLINICAL PROCEDURES","MDCA12","CLIO Cancel Transfer (A12)","CLIO Cancel Transfer (A12)")
D POSTKID^VDEFVU("ADT","A13","CPCDE","MDC CPCDE VS","CLINICAL PROCEDURES","MDCA13","CLIO Cancel Discharge (A13)","CLIO Cancel Discharge (A13)")
;
D MES^XPDUTL(" New VDEF events filed, remember to activate those needed for this installation")
;
D POSTCHK^MDTERM ; Checks for inactive term issues
;
; Delete previous CPManager compatability entries in XPAR.
N MDAPVSNS,MDAPPVSN S MDAPPVSN=0
D GETLST^XPAR(.MDAPVSNS,"SYS","MD VERSION CHK","Q")
F S MDAPPVSN=$O(MDAPVSNS(MDAPPVSN)) Q:'MDAPPVSN D
.I $P(MDAPVSNS(MDAPPVSN),U)["CPMANAGER.EXE" D EN^XPAR("SYS","MD VERSION CHK",$P(MDAPVSNS(MDAPPVSN),U,1),"@")
;
D MES^XPDUTL(" MD*1.0*16 Post Init complete")
Q
;
IMPORT ; Post installation of items with pointers beyond .01 field.
;
; Install a new command set from KIDS global
;
D MES^XPDUTL(" Installing command file...")
D NDEL^XPAR("SYS","MD COMMANDS")
S MDCMD="" F S MDCMD=$O(@XPDGREF@("MD COMMANDS",MDCMD)) Q:MDCMD="" D
.D MES^XPDUTL(" Installing command '"_MDCMD_"'...")
.K MDTXT M MDTXT=@XPDGREF@("MD COMMANDS",MDCMD)
.D EN^XPAR("SYS","MD COMMANDS",MDCMD,.MDTXT)
;
; Import the CDM data from the transport global
;
D MES^XPDUTL(" Importing a new Dictionary and Clinical Data Model.")
N MD,DA,DIK,MDCMD,MDD,MDA,MDIEN,MDFDA,MDIENS,MDFLD
;
; First we purge the existing CDM just in case the pre-init didn't get it blown away
F MD=704.103,704.104,704.105,704.106,704.107,704.108,704.109 D:$$VFILE^DILFD(MD)
.S DIK=$$ROOT^DILFD(MD) F DA=0:0 S DA=$O(@(DIK_"DA)")) Q:'DA D ^DIK
;
; Next we deactivate all the terms already here so only the new ones coming in are active
I $O(^MDC(704.101,0)) D MES^XPDUTL(" Deactivating existing terms.")
F MDIEN=0:0 S MDIEN=$O(^MDC(704.101,MDIEN)) Q:'MDIEN D
.S MDFDA(704.101,MDIEN_",",.09)=0 D FILE^DIE("","MDFDA")
;
; Now install the new one
D MES^XPDUTL(" Installing new terminology.")
K ^TMP($J,"MDFDA") S MDIEN=0
F X=0:0 S X=$O(@XPDGREF@("CDM",X)) Q:'X D
.S Y=@XPDGREF@("CDM",X)
.S MDD=+$P(Y,";",1)
.S MDIENS=+$P(Y,";",2)
.S MDFLD=+$P(Y,";",3)
.S ^TMP($J,"MDFDA",MDD,MDIENS,MDFLD)=$P(Y,U,2,250)
F MDD=0:0 S MDD=$O(^TMP($J,"MDFDA",MDD)) Q:'MDD D
.F MDA=0:0 S MDA=$O(^TMP($J,"MDFDA",MDD,MDA)) Q:'MDA D
..K MDFDA
..S MDIENS="+1"
..S:MDD=704.101 MDIENS=$$GETIENS(^TMP($J,"MDFDA",MDD,MDA,.01))
..M MDFDA(MDD,MDIENS_",")=^TMP($J,"MDFDA",MDD,MDA)
..D UPDATE^DIE("EK","MDFDA",,"MDMSG")
..I $D(MDMSG) D MES^XPDUTL(MDMSG("DIERR",1,"TEXT",1))
..K MDMSG,MDFDA
;
; Update the check sums
F MDD=704.101,704.102,704.103,704.104,704.105,704.106,704.107,704.108,704.109 D
.D MES^XPDUTL(" Storing check sum for file "_$$GET1^DID(MDD,"","","NAME")_"...")
.D VRRV(MDD,"MD*1.0*16",MDBUILD)
;
D EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_VERSION",MDBUILD)
D EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_DESCRIPTION","Installed with KIDS Build MD*1.0*16")
;
D MES^XPDUTL(" New Clinical Data Model for Terminology has been installed.")
Q
;
GETIENS(MDID) ; Finds the correct IEN in the SITES TERM file
I $D(^MDC(704.101,"PK",MDID)) Q +$O(^MDC(704.101,"PK",MDID,0))
; No match in "PK" index, add it!
I 'MDIENS S MDIENS="+1" D MES^XPDUTL(" Term '"_^TMP($J,"MDFDA",MDD,MDA,.01)_"' ("_^(.02)_") will be added...")
Q MDIENS
;
VRRV(MDFILE,MDFRAME,MDVER) ; Tag the package revision data for a file
D PRD^DILFD(MDFILE,MDFRAME_";b"_MDBUILD_";"_$$CHKSUM^MDTERM(MDFILE))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPOST16 8498 printed Apr 09, 2024@20:48:37 Page 2
MDPOST16 ;HINES OIFO/DP - Post Installation Tasks;02 Mar 2008
+1 ;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine uses the following IAs:
+5 ; # 2263 - XPAR calls TOOLKIT (supported)
+6 ; # 4447 - POSTKID^VDEFVU VDEF (controlled subscription)
+7 ; #10141 - MES^XPDUTL Kernel (supported)
+8 ;
EN ; Post installation tasks to bring Legacy CP up to snuff
+1 ;
+2 NEW MDTMP,MDTASK,MDX,MDCMD,MDTXT,MDVER,MDBUILD
+3 SET MDBUILD=$PIECE($PIECE($TEXT(+2),";",7)," ",2)
+4 ;
+5 ; Import the new data
+6 ;
+7 DO IMPORT
+8 ;
+9 ; Remove obsolete parameters of where updates are located
+10 ;
+11 DO MES^XPDUTL(" Removing obsolete parameters ...")
+12 DO EN^XPAR("SYS","MD PARAMETERS","UPDATE_MASTER","@")
+13 DO EN^XPAR("SYS","MD PARAMETERS","UPDATE_FRAMEWORK","@")
+14 DO EN^XPAR("SYS","MD PARAMETERS","UPDATE_SOURCE","@")
+15 ;
+16 ; Remove old, unused routines. BLJ 17 March 2010
+17 NEW X
FOR X="MDCORE","MDCPST"
XECUTE ^%ZOSF("DEL")
+18 KILL X
+19 ;
+20 ; Update the queued jobs list
+21 ;
+22 ; load all pars into MDTASK() and then remove the XPAR copy of each TASK_*
+23 ;
+24 DO MES^XPDUTL(" Updating queued job settings ...")
+25 DO GETLST^XPAR(.MDTMP,"SYS","MD PARAMETERS","Q")
+26 FOR MDX=0:0
SET MDX=$ORDER(MDTMP(MDX))
if 'MDX
QUIT
if MDTMP(MDX)?1"TASK_".E
Begin DoDot:1
+27 SET MDTASK($PIECE(MDTMP(MDX),"^",1))=$PIECE(MDTMP(MDX),"^",2)
+28 DO EN^XPAR("SYS","MD PARAMETERS",$PIECE(MDTMP(MDX),"^",1),"@")
End DoDot:1
+29 ;
+30 ; Now rebuild the ones that we want to keep
+31 ;
+32 FOR X="TASK_CLIO_CLEANUP","TASK_CP_CLEANUP","TASK_HL7_CLEANUP"
Begin DoDot:1
+33 SET MDTASK(X)=$GET(MDTASK(X),"0;;;0")
End DoDot:1
+34 ;
+35 SET $PIECE(MDTASK("TASK_CLIO_CLEANUP"),";",2)="CliO Cleanup"
+36 SET $PIECE(MDTASK("TASK_CLIO_CLEANUP"),";",3)="CLIO MDCPURG"
+37 ;
+38 SET $PIECE(MDTASK("TASK_CP_CLEANUP"),";",2)="CP Cleanup"
+39 SET $PIECE(MDTASK("TASK_CP_CLEANUP"),";",3)="CP MDCPURG"
+40 ;
+41 SET $PIECE(MDTASK("TASK_HL7_CLEANUP"),";",2)="HL7 Cleanup"
+42 SET $PIECE(MDTASK("TASK_HL7_CLEANUP"),";",3)="HL7 MDCPURG"
+43 ;
+44 ; Save them back to XPAR
+45 ;
+46 FOR MDX="TASK_CLIO_CLEANUP","TASK_CP_CLEANUP","TASK_HL7_CLEANUP"
Begin DoDot:1
+47 DO EN^XPAR("SYS","MD PARAMETERS",MDX,MDTASK(MDX))
+48 DO MES^XPDUTL(" Task '"_MDX_"' updated...")
End DoDot:1
+49 ;
+50 ; Set the required build numbers for the applications (1.0.16.BUILD)
+51 ;
+52 FOR MDX="CPFLOWSHEETS","CPCONSOLE","CPGATEWAYSERVICE"
Begin DoDot:1
+53 DO EN^XPAR("SYS","MD PARAMETERS","VERSION_"_MDX,"1.0.16."_MDBUILD)
End DoDot:1
+54 ;
+55 ; Update the CP DEFINITION File with GUIDS and Active Status
+56 DO MES^XPDUTL(" Updating CP Definition File...")
+57 NEW MDX,MDY,MDFDA,MDIEN,MDFILE
+58 FOR MDX=0:0
SET MDX=$ORDER(^MDS(702.01,MDX))
if 'MDX
QUIT
Begin DoDot:1
+59 IF $PIECE($GET(^MDS(702.01,MDX,"ID")),U)'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}"
Begin DoDot:2
+60 FOR
DO GETGUID^MDCLIO1(.MDY)
if '$DATA(^MDS(702.01,"PK",MDY))
QUIT
+61 SET MDFDA(702.01,MDX_",",.13)=MDY
End DoDot:2
+62 SET MDFDA(702.01,MDX_",",.09)=1
+63 DO FILE^DIE("","MDFDA")
End DoDot:1
+64 ;
+65 ; Clear cache settings to force new build
+66 DO EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_CACHE_SETTINGS","@")
+67 DO MES^XPDUTL(" Terminology Caching disabled, use CP Console to rebuild.")
+68 ;
+69 ; Update the CP INSTRUMENT File with GUIDS and Active Status
+70 DO MES^XPDUTL(" Updating CP Instrument File...")
+71 FOR MDX=0:0
SET MDX=$ORDER(^MDS(702.09,MDX))
if 'MDX
QUIT
Begin DoDot:1
+72 IF $PIECE($GET(^MDS(702.09,MDX,"ID")),U)'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}"
Begin DoDot:2
+73 FOR
DO GETGUID^MDCLIO1(.MDY)
if '$DATA(^MDS(702.09,"PK",MDY))
QUIT
+74 SET MDFDA(702.09,MDX_",",.1)=MDY
End DoDot:2
+75 SET MDFDA(702.09,MDX_",",.09)=1
+76 DO FILE^DIE("","MDFDA")
End DoDot:1
+77 ;
+78 ; Add any needed VDEF entries
+79 ;
+80 ; IA 4447.
+81 ;
+82 ; Event subtypes:
+83 ; CPAN - CLIO Admit/Visit Notification (A01)
+84 ; CPCAN - CLIO Cancel Admit Notice (A11)
+85 ; CPCDE - CLIO Cancel Discharge (A13)
+86 ; CPCT - CLIO Cancel Transfer (A12)
+87 ; CPDE - CLIO Discharge/End Visit (A03)
+88 ; CPTP - CLIO Transfer a Patient (A02)
+89 ; CPUPI - CLIO Update Patient Info (A08)
+90 ;
+91 ; Message/Event types - Protocols - Extraction Program
+92 ; ADT/A01 - MDC CPAN VS - MDCA01
+93 ; ADT/A02 - MDC CPTP VS - MDCA02
+94 ; ADT/A03 - MDC CPDE VS - MDCA03
+95 ; ADT/A08 - MDC CPUPI VS - MDCA08
+96 ; ADT/A11 - MDC CPCAN VS - MDCA11
+97 ; ADT/A12 - MDC CPCT VS - MDCA12
+98 ; ADT/A13 - MDC CPCDE VS - MDCA13
+99 ;
+100 DO POSTKID^VDEFVU("ADT","A01","CPAN","MDC CPAN VS","CLINICAL PROCEDURES","MDCA01","CLIO Admit/Visit Notification (A01)","CLIO Admit/Visit Notification (A01)")
+101 DO POSTKID^VDEFVU("ADT","A02","CPTP","MDC CPTP VS","CLINICAL PROCEDURES","MDCA02","CLIO Transfer a Patient (A02)","CLIO Transfer a Patient (A02)")
+102 DO POSTKID^VDEFVU("ADT","A03","CPDE","MDC CPDE VS","CLINICAL PROCEDURES","MDCA03","CLIO Discharge/End Visit (A03)","CLIO Discharge/End Visit (A03)")
+103 DO POSTKID^VDEFVU("ADT","A08","CPUPI","MDC CPUPI VS","CLINICAL PROCEDURES","MDCA08","CLIO Update Patient Info (A08)","CLIO Update Patient Info (A08)")
+104 DO POSTKID^VDEFVU("ADT","A11","CPCAN","MDC CPCAN VS","CLINICAL PROCEDURES","MDCA11","CLIO Cancel Admit Notice (A11)","CLIO Cancel Admit Notice (A11)")
+105 DO POSTKID^VDEFVU("ADT","A12","CPCT","MDC CPCT VS","CLINICAL PROCEDURES","MDCA12","CLIO Cancel Transfer (A12)","CLIO Cancel Transfer (A12)")
+106 DO POSTKID^VDEFVU("ADT","A13","CPCDE","MDC CPCDE VS","CLINICAL PROCEDURES","MDCA13","CLIO Cancel Discharge (A13)","CLIO Cancel Discharge (A13)")
+107 ;
+108 DO MES^XPDUTL(" New VDEF events filed, remember to activate those needed for this installation")
+109 ;
+110 ; Checks for inactive term issues
DO POSTCHK^MDTERM
+111 ;
+112 ; Delete previous CPManager compatability entries in XPAR.
+113 NEW MDAPVSNS,MDAPPVSN
SET MDAPPVSN=0
+114 DO GETLST^XPAR(.MDAPVSNS,"SYS","MD VERSION CHK","Q")
+115 FOR
SET MDAPPVSN=$ORDER(MDAPVSNS(MDAPPVSN))
if 'MDAPPVSN
QUIT
Begin DoDot:1
+116 IF $PIECE(MDAPVSNS(MDAPPVSN),U)["CPMANAGER.EXE"
DO EN^XPAR("SYS","MD VERSION CHK",$PIECE(MDAPVSNS(MDAPPVSN),U,1),"@")
End DoDot:1
+117 ;
+118 DO MES^XPDUTL(" MD*1.0*16 Post Init complete")
+119 QUIT
+120 ;
IMPORT ; Post installation of items with pointers beyond .01 field.
+1 ;
+2 ; Install a new command set from KIDS global
+3 ;
+4 DO MES^XPDUTL(" Installing command file...")
+5 DO NDEL^XPAR("SYS","MD COMMANDS")
+6 SET MDCMD=""
FOR
SET MDCMD=$ORDER(@XPDGREF@("MD COMMANDS",MDCMD))
if MDCMD=""
QUIT
Begin DoDot:1
+7 DO MES^XPDUTL(" Installing command '"_MDCMD_"'...")
+8 KILL MDTXT
MERGE MDTXT=@XPDGREF@("MD COMMANDS",MDCMD)
+9 DO EN^XPAR("SYS","MD COMMANDS",MDCMD,.MDTXT)
End DoDot:1
+10 ;
+11 ; Import the CDM data from the transport global
+12 ;
+13 DO MES^XPDUTL(" Importing a new Dictionary and Clinical Data Model.")
+14 NEW MD,DA,DIK,MDCMD,MDD,MDA,MDIEN,MDFDA,MDIENS,MDFLD
+15 ;
+16 ; First we purge the existing CDM just in case the pre-init didn't get it blown away
+17 FOR MD=704.103,704.104,704.105,704.106,704.107,704.108,704.109
if $$VFILE^DILFD(MD)
Begin DoDot:1
+18 SET DIK=$$ROOT^DILFD(MD)
FOR DA=0:0
SET DA=$ORDER(@(DIK_"DA)"))
if 'DA
QUIT
DO ^DIK
End DoDot:1
+19 ;
+20 ; Next we deactivate all the terms already here so only the new ones coming in are active
+21 IF $ORDER(^MDC(704.101,0))
DO MES^XPDUTL(" Deactivating existing terms.")
+22 FOR MDIEN=0:0
SET MDIEN=$ORDER(^MDC(704.101,MDIEN))
if 'MDIEN
QUIT
Begin DoDot:1
+23 SET MDFDA(704.101,MDIEN_",",.09)=0
DO FILE^DIE("","MDFDA")
End DoDot:1
+24 ;
+25 ; Now install the new one
+26 DO MES^XPDUTL(" Installing new terminology.")
+27 KILL ^TMP($JOB,"MDFDA")
SET MDIEN=0
+28 FOR X=0:0
SET X=$ORDER(@XPDGREF@("CDM",X))
if 'X
QUIT
Begin DoDot:1
+29 SET Y=@XPDGREF@("CDM",X)
+30 SET MDD=+$PIECE(Y,";",1)
+31 SET MDIENS=+$PIECE(Y,";",2)
+32 SET MDFLD=+$PIECE(Y,";",3)
+33 SET ^TMP($JOB,"MDFDA",MDD,MDIENS,MDFLD)=$PIECE(Y,U,2,250)
End DoDot:1
+34 FOR MDD=0:0
SET MDD=$ORDER(^TMP($JOB,"MDFDA",MDD))
if 'MDD
QUIT
Begin DoDot:1
+35 FOR MDA=0:0
SET MDA=$ORDER(^TMP($JOB,"MDFDA",MDD,MDA))
if 'MDA
QUIT
Begin DoDot:2
+36 KILL MDFDA
+37 SET MDIENS="+1"
+38 if MDD=704.101
SET MDIENS=$$GETIENS(^TMP($JOB,"MDFDA",MDD,MDA,.01))
+39 MERGE MDFDA(MDD,MDIENS_",")=^TMP($JOB,"MDFDA",MDD,MDA)
+40 DO UPDATE^DIE("EK","MDFDA",,"MDMSG")
+41 IF $DATA(MDMSG)
DO MES^XPDUTL(MDMSG("DIERR",1,"TEXT",1))
+42 KILL MDMSG,MDFDA
End DoDot:2
End DoDot:1
+43 ;
+44 ; Update the check sums
+45 FOR MDD=704.101,704.102,704.103,704.104,704.105,704.106,704.107,704.108,704.109
Begin DoDot:1
+46 DO MES^XPDUTL(" Storing check sum for file "_$$GET1^DID(MDD,"","","NAME")_"...")
+47 DO VRRV(MDD,"MD*1.0*16",MDBUILD)
End DoDot:1
+48 ;
+49 DO EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_VERSION",MDBUILD)
+50 DO EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_DESCRIPTION","Installed with KIDS Build MD*1.0*16")
+51 ;
+52 DO MES^XPDUTL(" New Clinical Data Model for Terminology has been installed.")
+53 QUIT
+54 ;
GETIENS(MDID) ; Finds the correct IEN in the SITES TERM file
+1 IF $DATA(^MDC(704.101,"PK",MDID))
QUIT +$ORDER(^MDC(704.101,"PK",MDID,0))
+2 ; No match in "PK" index, add it!
+3 IF 'MDIENS
SET MDIENS="+1"
DO MES^XPDUTL(" Term '"_^TMP($JOB,"MDFDA",MDD,MDA,.01)_"' ("_^(.02)_") will be added...")
+4 QUIT MDIENS
+5 ;
VRRV(MDFILE,MDFRAME,MDVER) ; Tag the package revision data for a file
+1 DO PRD^DILFD(MDFILE,MDFRAME_";b"_MDBUILD_";"_$$CHKSUM^MDTERM(MDFILE))
+2 QUIT
+3 ;
