Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MDPOST16

MDPOST16.m

Go to the documentation of this file. 
  1. MDPOST16 ;HINES OIFO/DP - Post Installation Tasks;02 Mar 2008
  1.  ;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;  # 2263       - XPAR calls                   TOOLKIT                        (supported)
  1.  ;  # 4447       - POSTKID^VDEFVU               VDEF             (controlled subscription)
  1.  ;  #10141       - MES^XPDUTL                   Kernel                         (supported)
  1.  ;
  1. EN ; Post installation tasks to bring Legacy CP up to snuff
  1.  ;
  1.  N MDTMP,MDTASK,MDX,MDCMD,MDTXT,MDVER,MDBUILD
  1.  S MDBUILD=$P($P($T(+2),";",7)," ",2)
  1.  ;
  1.  ; Import the new data
  1.  ; 
  1.  D IMPORT
  1.  ;
  1.  ; Remove obsolete parameters of where updates are located
  1.  ; 
  1.  D MES^XPDUTL(" Removing obsolete parameters ...")
  1.  D EN^XPAR("SYS","MD PARAMETERS","UPDATE_MASTER","@")
  1.  D EN^XPAR("SYS","MD PARAMETERS","UPDATE_FRAMEWORK","@")
  1.  D EN^XPAR("SYS","MD PARAMETERS","UPDATE_SOURCE","@")
  1.  ;
  1.  ; Remove old, unused routines. BLJ 17 March 2010
  1.  N X F X="MDCORE","MDCPST" X ^%ZOSF("DEL")
  1.  K X
  1.  ;
  1.  ; Update the queued jobs list
  1.  ;
  1.  ; load all pars into MDTASK() and then remove the XPAR copy of each TASK_*
  1.  ;
  1.  D MES^XPDUTL(" Updating queued job settings ...")
  1.  D GETLST^XPAR(.MDTMP,"SYS","MD PARAMETERS","Q")
  1.  F MDX=0:0 S MDX=$O(MDTMP(MDX)) Q:'MDX  D:MDTMP(MDX)?1"TASK_".E
  1.  .S MDTASK($P(MDTMP(MDX),"^",1))=$P(MDTMP(MDX),"^",2)
  1.  .D EN^XPAR("SYS","MD PARAMETERS",$P(MDTMP(MDX),"^",1),"@")
  1.  ;
  1.  ; Now rebuild the ones that we want to keep
  1.  ;
  1.  F X="TASK_CLIO_CLEANUP","TASK_CP_CLEANUP","TASK_HL7_CLEANUP" D
  1.  .S MDTASK(X)=$G(MDTASK(X),"0;;;0")
  1.  ;
  1.  S $P(MDTASK("TASK_CLIO_CLEANUP"),";",2)="CliO Cleanup"
  1.  S $P(MDTASK("TASK_CLIO_CLEANUP"),";",3)="CLIO MDCPURG"
  1.  ;
  1.  S $P(MDTASK("TASK_CP_CLEANUP"),";",2)="CP Cleanup"
  1.  S $P(MDTASK("TASK_CP_CLEANUP"),";",3)="CP MDCPURG"
  1.  ;
  1.  S $P(MDTASK("TASK_HL7_CLEANUP"),";",2)="HL7 Cleanup"
  1.  S $P(MDTASK("TASK_HL7_CLEANUP"),";",3)="HL7 MDCPURG"
  1.  ;
  1.  ; Save them back to XPAR
  1.  ;
  1.  F MDX="TASK_CLIO_CLEANUP","TASK_CP_CLEANUP","TASK_HL7_CLEANUP" D
  1.  .D EN^XPAR("SYS","MD PARAMETERS",MDX,MDTASK(MDX))
  1.  .D MES^XPDUTL(" Task '"_MDX_"' updated...")
  1.  ;
  1.  ; Set the required build numbers for the applications (1.0.16.BUILD)
  1.  ;
  1.  F MDX="CPFLOWSHEETS","CPCONSOLE","CPGATEWAYSERVICE" D
  1.  .D EN^XPAR("SYS","MD PARAMETERS","VERSION_"_MDX,"1.0.16."_MDBUILD)
  1.  ;
  1.  ; Update the CP DEFINITION File with GUIDS and Active Status
  1.  D MES^XPDUTL(" Updating CP Definition File...")
  1.  N MDX,MDY,MDFDA,MDIEN,MDFILE
  1.  F MDX=0:0 S MDX=$O(^MDS(702.01,MDX)) Q:'MDX  D
  1.  .I $P($G(^MDS(702.01,MDX,"ID")),U)'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}" D
  1.  ..F  D GETGUID^MDCLIO1(.MDY) Q:'$D(^MDS(702.01,"PK",MDY))
  1.  ..S MDFDA(702.01,MDX_",",.13)=MDY
  1.  .S MDFDA(702.01,MDX_",",.09)=1
  1.  .D FILE^DIE("","MDFDA")
  1.  ;
  1.  ; Clear cache settings to force new build 
  1.  D EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_CACHE_SETTINGS","@")
  1.  D MES^XPDUTL(" Terminology Caching disabled, use CP Console to rebuild.")
  1.  ;
  1.  ; Update the CP INSTRUMENT File with GUIDS and Active Status
  1.  D MES^XPDUTL(" Updating CP Instrument File...")
  1.  F MDX=0:0 S MDX=$O(^MDS(702.09,MDX)) Q:'MDX  D
  1.  .I $P($G(^MDS(702.09,MDX,"ID")),U)'?1"{"8UN1"-"4UN1"-"4UN1"-"4UN1"-"12UN1"}" D
  1.  ..F  D GETGUID^MDCLIO1(.MDY) Q:'$D(^MDS(702.09,"PK",MDY))
  1.  ..S MDFDA(702.09,MDX_",",.1)=MDY
  1.  .S MDFDA(702.09,MDX_",",.09)=1
  1.  .D FILE^DIE("","MDFDA")
  1.  ;
  1.  ; Add any needed VDEF entries
  1.  ;
  1.  ; IA 4447.
  1.  ;
  1.  ; Event subtypes:
  1.  ;   CPAN - CLIO Admit/Visit Notification (A01)
  1.  ;   CPCAN - CLIO Cancel Admit Notice (A11)
  1.  ;   CPCDE - CLIO Cancel Discharge (A13)
  1.  ;   CPCT - CLIO Cancel Transfer (A12)
  1.  ;   CPDE - CLIO Discharge/End Visit (A03)
  1.  ;   CPTP - CLIO Transfer a Patient (A02)
  1.  ;   CPUPI - CLIO Update Patient Info (A08)
  1.  ;
  1.  ; Message/Event types - Protocols - Extraction Program
  1.  ;   ADT/A01 - MDC CPAN VS   - MDCA01
  1.  ;   ADT/A02 - MDC CPTP VS   - MDCA02
  1.  ;   ADT/A03 - MDC CPDE VS   - MDCA03
  1.  ;   ADT/A08 - MDC CPUPI VS  - MDCA08
  1.  ;   ADT/A11 - MDC CPCAN VS  - MDCA11
  1.  ;   ADT/A12 - MDC CPCT VS   - MDCA12
  1.  ;   ADT/A13 - MDC CPCDE VS  - MDCA13
  1.  ;
  1.  D POSTKID^VDEFVU("ADT","A01","CPAN","MDC CPAN VS","CLINICAL PROCEDURES","MDCA01","CLIO Admit/Visit Notification (A01)","CLIO Admit/Visit Notification (A01)")
  1.  D POSTKID^VDEFVU("ADT","A02","CPTP","MDC CPTP VS","CLINICAL PROCEDURES","MDCA02","CLIO Transfer a Patient (A02)","CLIO Transfer a Patient (A02)")
  1.  D POSTKID^VDEFVU("ADT","A03","CPDE","MDC CPDE VS","CLINICAL PROCEDURES","MDCA03","CLIO Discharge/End Visit (A03)","CLIO Discharge/End Visit (A03)")
  1.  D POSTKID^VDEFVU("ADT","A08","CPUPI","MDC CPUPI VS","CLINICAL PROCEDURES","MDCA08","CLIO Update Patient Info (A08)","CLIO Update Patient Info (A08)")
  1.  D POSTKID^VDEFVU("ADT","A11","CPCAN","MDC CPCAN VS","CLINICAL PROCEDURES","MDCA11","CLIO Cancel Admit Notice (A11)","CLIO Cancel Admit Notice (A11)")
  1.  D POSTKID^VDEFVU("ADT","A12","CPCT","MDC CPCT VS","CLINICAL PROCEDURES","MDCA12","CLIO Cancel Transfer (A12)","CLIO Cancel Transfer (A12)")
  1.  D POSTKID^VDEFVU("ADT","A13","CPCDE","MDC CPCDE VS","CLINICAL PROCEDURES","MDCA13","CLIO Cancel Discharge (A13)","CLIO Cancel Discharge (A13)")
  1.  ;
  1.  D MES^XPDUTL(" New VDEF events filed, remember to activate those needed for this installation")
  1.  ;
  1.  D POSTCHK^MDTERM ; Checks for inactive term issues
  1.  ;
  1.  ; Delete previous CPManager compatability entries in XPAR.
  1.  N MDAPVSNS,MDAPPVSN S MDAPPVSN=0
  1.  D GETLST^XPAR(.MDAPVSNS,"SYS","MD VERSION CHK","Q")
  1.  F  S MDAPPVSN=$O(MDAPVSNS(MDAPPVSN)) Q:'MDAPPVSN  D
  1.  .I $P(MDAPVSNS(MDAPPVSN),U)["CPMANAGER.EXE" D EN^XPAR("SYS","MD VERSION CHK",$P(MDAPVSNS(MDAPPVSN),U,1),"@")
  1.  ;
  1.  D MES^XPDUTL(" MD*1.0*16 Post Init complete")
  1.  Q
  1.  ;
  1. IMPORT ; Post installation of items with pointers beyond .01 field.
  1.  ;
  1.  ; Install a new command set from KIDS global
  1.  ;
  1.  D MES^XPDUTL(" Installing command file...")
  1.  D NDEL^XPAR("SYS","MD COMMANDS")
  1.  S MDCMD="" F  S MDCMD=$O(@XPDGREF@("MD COMMANDS",MDCMD)) Q:MDCMD=""  D
  1.  .D MES^XPDUTL(" Installing command '"_MDCMD_"'...")
  1.  .K MDTXT M MDTXT=@XPDGREF@("MD COMMANDS",MDCMD)
  1.  .D EN^XPAR("SYS","MD COMMANDS",MDCMD,.MDTXT)
  1.  ;
  1.  ; Import the CDM data from the transport global
  1.  ; 
  1.  D MES^XPDUTL(" Importing a new Dictionary and Clinical Data Model.")
  1.  N MD,DA,DIK,MDCMD,MDD,MDA,MDIEN,MDFDA,MDIENS,MDFLD
  1.  ;
  1.  ; First we purge the existing CDM just in case the pre-init didn't get it blown away
  1.  F MD=704.103,704.104,704.105,704.106,704.107,704.108,704.109 D:$$VFILE^DILFD(MD)
  1.  .S DIK=$$ROOT^DILFD(MD) F DA=0:0 S DA=$O(@(DIK_"DA)")) Q:'DA  D ^DIK
  1.  ;
  1.  ; Next we deactivate all the terms already here so only the new ones coming in are active
  1.  I $O(^MDC(704.101,0)) D MES^XPDUTL(" Deactivating existing terms.")
  1.  F MDIEN=0:0 S MDIEN=$O(^MDC(704.101,MDIEN)) Q:'MDIEN  D
  1.  .S MDFDA(704.101,MDIEN_",",.09)=0 D FILE^DIE("","MDFDA")
  1.  ;
  1.  ; Now install the new one
  1.  D MES^XPDUTL(" Installing new terminology.")
  1.  K ^TMP($J,"MDFDA") S MDIEN=0
  1.  F X=0:0 S X=$O(@XPDGREF@("CDM",X)) Q:'X  D
  1.  .S Y=@XPDGREF@("CDM",X)
  1.  .S MDD=+$P(Y,";",1)
  1.  .S MDIENS=+$P(Y,";",2)
  1.  .S MDFLD=+$P(Y,";",3)
  1.  .S ^TMP($J,"MDFDA",MDD,MDIENS,MDFLD)=$P(Y,U,2,250)
  1.  F MDD=0:0 S MDD=$O(^TMP($J,"MDFDA",MDD)) Q:'MDD  D
  1.  .F MDA=0:0 S MDA=$O(^TMP($J,"MDFDA",MDD,MDA)) Q:'MDA  D
  1.  ..K MDFDA
  1.  ..S MDIENS="+1"
  1.  ..S:MDD=704.101 MDIENS=$$GETIENS(^TMP($J,"MDFDA",MDD,MDA,.01))
  1.  ..M MDFDA(MDD,MDIENS_",")=^TMP($J,"MDFDA",MDD,MDA)
  1.  ..D UPDATE^DIE("EK","MDFDA",,"MDMSG")
  1.  ..I $D(MDMSG) D MES^XPDUTL(MDMSG("DIERR",1,"TEXT",1))
  1.  ..K MDMSG,MDFDA
  1.  ;
  1.  ; Update the check sums
  1.  F MDD=704.101,704.102,704.103,704.104,704.105,704.106,704.107,704.108,704.109 D
  1.  .D MES^XPDUTL(" Storing check sum for file "_$$GET1^DID(MDD,"","","NAME")_"...")
  1.  .D VRRV(MDD,"MD*1.0*16",MDBUILD)
  1.  ;
  1.  D EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_VERSION",MDBUILD)
  1.  D EN^XPAR("SYS","MD PARAMETERS","TERMINOLOGY_DESCRIPTION","Installed with KIDS Build MD*1.0*16")
  1.  ;
  1.  D MES^XPDUTL(" New Clinical Data Model for Terminology has been installed.")
  1.  Q
  1.  ;
  1. GETIENS(MDID) ; Finds the correct IEN in the SITES TERM file
  1.  I $D(^MDC(704.101,"PK",MDID)) Q +$O(^MDC(704.101,"PK",MDID,0))
  1.  ; No match in "PK" index, add it!
  1.  I 'MDIENS S MDIENS="+1" D MES^XPDUTL("    Term '"_^TMP($J,"MDFDA",MDD,MDA,.01)_"' ("_^(.02)_") will be added...")
  1.  Q MDIENS
  1.  ;
  1. VRRV(MDFILE,MDFRAME,MDVER) ; Tag the package revision data for a file
  1.  D PRD^DILFD(MDFILE,MDFRAME_";b"_MDBUILD_";"_$$CHKSUM^MDTERM(MDFILE))
  1.  Q
  1.  ;