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

XU8P1018.m

Go to the documentation of this file. 
  1. XU8P1018 ;IHS/OIT/FBD - XU V8.0 PATCH 1018 ;
  1.  ;;8.0;KERNEL;**1018**;JUNE 4, 2015;Build 8
  1.  ;
  1.  ;
  1. ENV ;ENVIROMENT CHECK
  1.  I '$G(IOM) D HOME^%ZIS
  1.  ;
  1.  I '$G(DUZ) D MES^XPDUTL("No valid user identification found; aborting.") D SORRY(2) Q
  1.  ;
  1.  I '$L($G(DUZ(0))) D MES^XPDUTL("No valid user location found; aborting.") D SORRY(2) Q
  1.  ;
  1.  S X=$P(^VA(200,DUZ,0),U)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_" Patch "_$P($T(+2),";",5)_".",IOM)
  1.  ;
  1.  NEW IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  ;
  1.  I $$VCHK("DI","22.0",2)
  1.  I $$VCHK("XT","7.3",2)
  1.  I $$VCHK("XM","8.0",2)
  1.  I $$VCHK("XU","8.0",2)
  1.  ;
  1.  I '$$INSTALLD("DI*22.0*170") D SORRY(2)
  1.  I '$$INSTALLD("XT*7.3*137") D SORRY(2)
  1.  I '$$INSTALLD("XM*8.0*45") D SORRY(2)
  1.  I '$$INSTALLD("XU*8.0*638") D SORRY(2)
  1.  ;
  1.  NEW DA,DIC
  1.  S X="AUPN",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","AUPN")) D  Q
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""AUPN"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
  1.  . D SORRY(2)
  1.  .Q
  1.  ;
  1.  I $G(XPDQUIT) W !,$$CJ^XLFSTR(IORVON_"FIX IT! Before Proceeding."_IORVOFF,IOM),!!,*7,*7,*7 Q
  1.  ;
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"),XPDDIQ("XPO1"),XPDDIQ("XPI1"))=0
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(3)
  1.  Q  ;ENVIRONMENT CHECK EXIT
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1.  ; 
  1. VCHK(AUPNPRE,AUPNVER,AUPNQUIT) ; Check versions needed.
  1.  ;  
  1.  NEW AUPNV
  1.  S AUPNV=$$VERSION^XPDUTL(AUPNPRE)
  1.  W !,$$CJ^XLFSTR("Need at least "_AUPNPRE_" v "_AUPNVER_"....."_AUPNPRE_" v "_AUPNV_" Present",IOM)
  1.  I AUPNV<AUPNVER D SORRY(AUPNQUIT) Q 0
  1.  Q 1
  1.  ;
  1.  ;
  1. POST ;EP - XU V8.0 PATCH 1018 POST-INIT
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR("Beginning XU v8.0 patch 1018 post-init process.",80))
  1.  ;
  1.  D BMES^XPDUTL($$CJ^XLFSTR("Running ^ZTMGRSET to verify deployment of IHS-modified %-routines...",80))
  1.  D ^ZTMGRSET
  1.  ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Changing Kernel temp file settings to Cache-appropriate default...",80))
  1.  K DA,DIE,DR
  1.  S DIE="^XTV(8989.3,",DA=1,DR=".07///1"
  1.  D ^DIE
  1.  ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Cleaning up mail group/member cross-references...",80))
  1.  K ^XMB(3.8,"AB")  ;FLUSH MAIL GROUP FILE'S OLD 'AB' XREF (MEMBER/MAIL GROUP)
  1.  S XUMG=0  ;INITIAL SEED VALUE TO LOOP THROUGH ALL MAIL GROUPS
  1.  F  S XUMG=$O(^XMB(3.8,XUMG)) Q:XUMG'=+XUMG  D  ;RUN THROUGH ALL MAIL GROUPS
  1.  . K DIK,DA
  1.  . S DIK="^XMB(3.8,"_XUMG_",1,"  ;MEMBER SUBFILE GLOBAL ROOT FOR THIS MAIL GROUP
  1.  . S DIK(1)=".01^AB"  ;EXECUTE 'SET' LOGIC ON MEMBER FIELD'S AB XREF ONLY
  1.  . S DA(1)=XUMG
  1.  . D ENALL^DIK
  1.  K DIK,DA
  1.  ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Purging obsolete user edit templates...",80))
  1.  F XUZTEMP="XUEDIT CHARACTERISTICS","XUEXISTING USER","XUNEW USER" D  ;SCAN FOR FILE 3/FILE 200-CONFLICTING USER EDIT TEMPLATES
  1.  . S XUZDA=""
  1.  . F  S XUZDA=$O(^DIE("B",XUZTEMP,XUZDA)) Q:'+XUZDA  D  ;SCAN FOR MULTIPLE ENTRIES OF SPECIFIED TEMPLATE
  1.  . . I $P($G(^DIE(XUZDA,0)),U,4)=3 D  ;KILL IF SPECIFIED ENTRY IS ASSOCIATED WITH FILE 3 (USER) - ONLY FILE 200 (NEW USER) ASSOCIATED TEMPLATES SHOULD REMAIN
  1.  . . . K DA,DIE,DR
  1.  . . . S DIE="^DIE(",DA=XUZDA,DR=".01///@"
  1.  . . . D ^DIE
  1.  K XUZTEMP,XUZDA
  1.  ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("After purge, verifying Kernel reference of valid user edit template...",80))
  1.  S XUZTEMP=$P(^XTV(8989.3,1,3),U,2)  ;CURRENT 'USER CHARACTERISTICS TEMPLATE' FIELD REFERENCE
  1.  I $D(^DIE(XUZTEMP,0)) D  ;LEAVE ALONE IF EXISTING TEMPLATE REFERENCE IS VALID
  1.  . D MES^XPDUTL($$CJ^XLFSTR("- Valid template reference exists.",80))
  1.  . I 1
  1.  E  D  ;ELSE FIX IF REFERENCED TEMPLATE NO LONGER EXISTS AFTER PURGE
  1.  . D MES^XPDUTL($$CJ^XLFSTR("- Valid template reference does NOT exist; correcting...",80))
  1.  . S XUZTEMP="XUEDIT CHARACTERISTICS"  ;KERNEL'S DEFAULT USER EDIT TEMPLATE
  1.  . S XUZDA=$O(^DIE("B",XUZTEMP,""))  ;LOCATE DEFAULT TEMPLATE
  1.  . K DA,DIE,DR
  1.  . S DIE="^XTV(8989.3,",DA=1
  1.  . S DR="12///"_$S(+XUZDA:"`"_XUZDA,1:"@")  ;USE DEFAULT TEMPLATE IEN IF LOCATED, ELSE FLUSH 'USER CHARACTERISTICS TEMPLATE' FIELD OF BAD POINTER
  1.  . D ^DIE
  1.  K XUZTEMP,XUZDA
  1.  ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Re-verifying/cleaning up ""PT"" file pointer indication nodes...",80))
  1.  D ^XBFIXPT
  1.  ;
  1.  ;
  1.  D BMES^XPDUTL("Delivering XU*8.0*1018 install message to select users...")
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("XU8P1018",$J)
  1.  S ^TMP("XU8P1018",$J,1)=" --- XU v 8.0, Patch 1018, has been installed into this uci ---"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   S ^TMP("XU8P1018",$J,(%+1))=" "_^(%,0)
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""XU8P1018"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("XU8P1018",$J)
  1.  Q
  1.  ;
  1. SINGLE(K) ; Get holders of a single key K.
  1.  NEW Y
  1.  S Y=0
  1.  Q:'$D(^XUSEC(K))
  1.  F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""
  1.  Q
  1.  ;
  1. INSTALLD(AUPNSTAL) ;EP - Determine if patch AUPNSTAL was installed, where
  1.  ; AUPNSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW AUPNY,DIC,X,Y
  1.  S X=$P(AUPNSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(AUPNSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(AUPNSTAL,"*",3)
  1.  D ^DIC
  1.  S AUPNY=Y
  1.  D IMES
  1.  Q $S(AUPNY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_AUPNSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1.  ;