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

BTIUP9.m

Go to the documentation of this file. 
  1. BTIUP9 ; IHS/CIA/MGH - POST INSTALL FOR PATCH 1009;05-Jan-2012 14:45;DU
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**1009**;SEPT 04, 2005;Build 22
  1.  ;
  1. ENV ;EP environment check
  1.  N PATCH,STAT,INSTDA
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;
  1.  S PATCH="TIU*1.0*1007"
  1.  I '$$PATCH(PATCH) D  Q
  1.  . W !,"You must first install "_PATCH_"." S XPDABORT=1
  1.  S PATCH="TIU*1.0*1008"
  1.  I '$$PATCH(PATCH) D  Q
  1.  . W !,"You must first install "_PATCH_"." S XPDABORT=1
  1.  S PATCH="BJPC*2.0*6"
  1.  I '$$PATCH(PATCH) D  Q
  1.  . W !,"You must first install "_PATCH_"." S XPDABORT=1
  1.  ;Check for the installation of the ICARE
  1.  S IN="ICARE MANAGEMENT SYSTEM 2.1",INSTDA=""
  1.  I '$D(^XPD(9.7,"B",IN)) D  Q
  1.  .W !,"You must first install the ICARE 2.1 before this patch" S XPDABORT=1
  1.  S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
  1.  S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
  1.  I STAT'=3 D
  1.  .W !,"ICARE 2.1 must be completely installed before installing this patch." S XPDABORT=1
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;Check for EHR installation
  1.  S IN="EHR*1.1*8",INSTDA=""
  1.  I '$D(^XPD(9.7,"B",IN)) D  Q
  1.  .W !,"You must first install the EHR patch 8 before installing patch TIU patch 1009" S XPDABORT=1
  1.  S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
  1.  S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
  1.  I STAT'=3 D  Q
  1.  .W !,"EHR patch 8 must be completely installed before installing TIU patch 1009" S XPDABORT=1
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  ;Redo the environment checker for patch 113
  1.  N CHKOK,TIULOC S CHKOK=1,TIULOC=0
  1.  W !!,"Checking DIVISION for all Hospital Location file (#44)"
  1.  W !,"entries <AND> INSTITUTION FILE POINTER for all Medical"
  1.  W !,"Center Division file (#40.8) entries..."
  1.  W !!
  1.  ;
  1.  F  S TIULOC=$O(^SC(TIULOC)) Q:'TIULOC!('CHKOK)  D
  1.  . N TIUDVHL
  1.  . S TIUDVHL=+$P($G(^SC(TIULOC,0)),U,15) I 'TIUDVHL S CHKOK=0 Q
  1.  I CHKOK=1 D
  1.  . N TIUDIV,TIUIFP S TIUDIV=0
  1.  . F  S TIUDIV=$O(^DG(40.8,TIUDIV)) Q:'TIUDIV!('CHKOK)  D
  1.  . . S TIUIFP=+$G(^DG(40.8,"ADV",TIUDIV)) I 'TIUIFP S CHKOK=0 Q
  1.  ;
  1.  I 'CHKOK D
  1.  . S XPDABORT=1 ; kill transport global from ^XTMP
  1.  . W !,"Sorry...DIVISION cannot be determined for all Hospital"
  1.  . W !,"Location file (#44) entries <AND/OR> INSTITUTION FILE"
  1.  . W !,"POINTER cannot be determined for all Medical Center"
  1.  . W !,"Division file (#40.8) entries. Please review and correct"
  1.  . W !,"both files as necessary."
  1.  . W !!,"** ABORTING INSTALLATION **"
  1.  E  D
  1.  . W !,"** Files are OK **"
  1.  Q
  1.  ;
  1. PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
  1.  ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numbers
  1.  Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
  1.  NEW NUM,I,J
  1.  S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
  1.  S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
  1.  ;check if patch is just a number
  1.  Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
  1.  S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
  1.  Q (X=+NUM)
  1.  ;
  1. PRE ;EP; beginning of pre install code
  1.  Q
  1.  ;
  1. POST ;EP; beginning of post install code
  1.  N SECURITY
  1.  S SECURITY("RD")="#"
  1.  S SECURITY("DD")="@"
  1.  S SECURITY("DEL")="#"
  1.  S SECURITY("WR")="#"
  1.  S SECURITY("LAYGO")="#"
  1.  S SECURITY("AUDIT")="@"
  1.  D FILESEC^DDMOD(8927,.SECURITY)
  1.  ;Add the items to the menu
  1.  D REGMENU^BEHUTIL("BTIU SPECIAL REPORTS",,"HIMS","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU BROWSE PAT BY MR",,"IPD","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU DOC LIST",,"LAD","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU BTIU REVIEW SCREEN MR",,"MPD","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU MENU PRINT DOCS",,"PDM","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU IC LISTING",,"SIG","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU SEARCH FOR MR",,"SSD","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU MENU STATS REPORTS",,"STR","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU MENU MGR",,"TMM","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("TIU UNSIGNED/UNCOSIGNED REPORT",,"UNS","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU MENU UPLOAD",,"UPL","BTIU MENU2")
  1.  D REGMENU^BEHUTIL("BTIU VIEW USER ALERTS",,"VUA","BTIU MENU2")
  1.  Q