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

PXRMP5I.m

Go to the documentation of this file. 
  1. PXRMP5I ; SLC/AGP - Patch 5 init routine. ;09/16/2005
  1.  ;;2.0;CLINICAL REMINDERS;**5**;Feb 04, 2005
  1.  ;Reminder Exchange install.
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. ARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
  1.  ;
  1.  S ARRAY(1,1)="VA-IRAQ & AFGHAN POST-DEPLOY SCREEN"
  1.  I MODE S ARRAY(1,2)="09/20/2005@10:35:40"
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. DELDD ;Delete the old data dictionaries.
  1.  N DIU,TEXT
  1.  D EN^DDIOL("Removing old data dictionaries.")
  1.  S DIU(0)=""
  1.  S DIU=811.6
  1.  S TEXT=" Deleting data dictionary for file # "_DIU
  1.  D EN^DDIOL(TEXT)
  1.  D EN^DIU2
  1.  Q
  1.  ;===============================================================
  1. DELEI ;If the Exchange File entry already exists delete it.
  1.  N ARRAY,IC,IND,LIST,LUVALUE,NUM
  1.  D ARRAY(1,.ARRAY)
  1.  S IC=0
  1.  F  S IC=$O(ARRAY(IC)) Q:'IC  D
  1.  .S LUVALUE(1)=ARRAY(IC,1)
  1.  .D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
  1.  .I '$D(LIST) Q
  1.  .S NUM=$P(LIST("DILIST",0),U,1)
  1.  .I NUM'=0 D
  1.  ..F IND=1:1:NUM D
  1.  ... N DA,DIK
  1.  ... S DIK="^PXD(811.8,"
  1.  ... S DA=LIST("DILIST",2,IND)
  1.  ... D ^DIK
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to
  1.  ;include in the build. This is used in the build to determine which
  1.  ;entries to include.
  1.  N ARRAY,FOUND,IEN,IC,LUVALUE
  1.  D ARRAY(1,.ARRAY)
  1.  S FOUND=0
  1.  S IC=0
  1.  F  S IC=+$O(ARRAY(IC)) Q:(IC=0)!(FOUND)  D
  1.  . M LUVALUE=ARRAY(IC)
  1.  . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
  1.  . I IEN=Y S FOUND=1 Q
  1.  Q FOUND
  1.  ;
  1. PRE ;
  1.  D SSPC
  1.  D DELDD
  1.  D DELEI
  1.  Q
  1. POST ;
  1.  D RSPC
  1.  ;D SMEXINS
  1.  Q
  1.  ;===============================================================
  1. RSPC ;Restore the sponser classes to the new location.
  1.  N ARRAY,CLASS,IEN,NAME,TEMP
  1.  S ARRAY("INFECTIOUS DISEASES PROGRAM OFFICE, VAHQ")="N"
  1.  S ARRAY("JOHN D DEMAKIS")="N"
  1.  S ARRAY("Mental Health and Behavioral Science Strategic Group")="N"
  1.  S ARRAY("Mental Health and Behavioral Science Strategic Group and Women Veterans Health Program")="N"
  1.  S ARRAY("National Clinical Practice Guideline Council")="N"
  1.  S ARRAY("Office of Geriatric Extended Care")="N"
  1.  S ARRAY("Office of Public Health and Environmental Hazards")="N"
  1.  S ARRAY("Office of Quality & Performance")="N"
  1.  S ARRAY("Women Veterans Health Program")="N"
  1.  D BMES^XPDUTL("Restoring Sponsor Classes")
  1.  S IEN=0
  1.  F  S IEN=+$O(^XTMP("PXRMSPCS",IEN)) Q:IEN=0  D
  1.  . S CLASS=^XTMP("PXRMSPCS",IEN)
  1.  . S $P(^PXRMD(811.6,IEN,100),U,1)=CLASS
  1.  S IEN=0
  1.  F  S IEN=$O(^PXRMD(811.6,IEN)) Q:IEN'>0  D
  1.  . S CLASS=$P($G(^PXRMD(811.6,IEN,100)),U)
  1.  . I CLASS="" D
  1.  . .S TEMP=$P($G(^PXRMD(811.6,IEN,0)),U,2)
  1.  . .S NAME=$P($G(^PXRMD(811.6,IEN,0)),U) Q:NAME=""
  1.  . .I TEMP="" S TEMP=$S($D(ARRAY(NAME))>0:ARRAY(NAME),1:"L")
  1.  . .S $P(^PXRMD(811.6,IEN,100),U)=TEMP,CLASS=TEMP
  1.  . I CLASS'="" D
  1.  . .S TEMP=^PXRMD(811.6,IEN,0)
  1.  . .S ^PXRMD(811.6,IEN,0)=$P(TEMP,U)
  1.  Q
  1.  ;===============================================================
  1. SMEXINS ;Silent mode install.
  1.  N ARRAY,IC,IEN,LUVALUE,PXRMINST
  1.  S PXRMINST=1
  1.  D ARRAY(1,.ARRAY)
  1.  S IC=0
  1.  F  S IC=$O(ARRAY(IC)) Q:'IC  D
  1.  .M LUVALUE=ARRAY(IC)
  1.  .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
  1.  .I IEN'=0 D
  1.  .. N TEXT
  1.  .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
  1.  .. E  S TEXT="Installing reminder "_LUVALUE(1)
  1.  .. D BMES^XPDUTL(TEXT)
  1.  .. D INSTALL^PXRMEXSI(IEN,1)
  1.  Q
  1.  ;
  1.  ;===============================================================
  1. SSPC ;Save the Sponsor classes.
  1.  N CDATE,CLASS,IEN,PDATE
  1.  D BMES^XPDUTL("Saving Sponsor Classes")
  1.  S CDATE=$$NOW^XLFDT
  1.  S PDATE=$$FMADD^XLFDT(CDATE,30)
  1.  S ^XTMP("PXRMSPCS",0)=PDATE_U_CDATE_U_"SPONSOR CLASSES"
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXRMD(811.6,IEN)) Q:IEN=0  D
  1.  . S CLASS=$P($G(^PXRMD(811.6,IEN,0)),U,2)
  1.  . ;CHECK FOR TEST SITES
  1.  . I $G(CLASS)="" S CLASS=$P($G(^PXRMD(811.6,IEN,100)),U)
  1.  . S ^XTMP("PXRMSPCS",IEN)=CLASS
  1.  Q