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

PXRMEXSI.m

Go to the documentation of this file. 
  1. PXRMEXSI ;SLC/PKR/PJH - Silent Exchange entry install. ;10/10/2019
  1.  ;;2.0;CLINICAL REMINDERS;**6,12,17,18,24,45**;Feb 04, 2005;Build 566
  1.  ;
  1.  ;=======================================
  1. DELEXE(ENTRY,ROUTINE) ;If the Exchange File entry already exists delete it.
  1.  N EXARRAY,IC,IND,LIST,LUVALUE,NUM
  1.  D LDARRAY^PXRMEXSI("L",ENTRY,ROUTINE,.EXARRAY)
  1.  S IC=0
  1.  F  S IC=$O(EXARRAY(IC)) Q:'IC  D
  1.  . S LUVALUE(1)=EXARRAY(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,ENTRY,ROUTINE) ;Return a 1 if the Exchange file entry is in the list
  1.  ;to include in the build. This is used in the build to determine which
  1.  ;entries to include.
  1.  N EXARRAY,FOUND,IEN,IC,LUVALUE
  1.  D LDARRAY^PXRMEXSI("I",ENTRY,ROUTINE,.EXARRAY)
  1.  S FOUND=0
  1.  S IC=0
  1.  F  S IC=+$O(EXARRAY(IC)) Q:(IC=0)!(FOUND)  D
  1.  . M LUVALUE=EXARRAY(IC)
  1.  . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
  1.  . I IEN=Y S FOUND=1 Q
  1.  Q FOUND
  1.  ;
  1.  ;=======================================
  1. INSCOM(PXRMRIEN,ACTION,IND,TEMP,HISTSUB) ;Install component IND
  1.  ;of PXRMRIEN.
  1.  N ATTR,CSUM,END,EXISTS,FILENUM,IND120,JND120,NAME
  1.  N PT01,RTN,SAME,START,TEXT
  1.  S FILENUM=$P(TEMP,U,1),EXISTS=$P(TEMP,U,4)
  1.  S IND120=$P(TEMP,U,2),JND120=$P(TEMP,U,3)
  1.  I (IND120="")!(JND120="") Q
  1.  S TEMP=^PXD(811.8,PXRMRIEN,120,IND120,1,JND120,0)
  1.  ;If the component does not exist then the action has to be "I".
  1.  ;If the component exists and the action is "I" change it to "O".
  1.  ;Otherwise leave the action as is.
  1.  S ACTION=$S('EXISTS:"I",ACTION="I":"O",1:ACTION)
  1.  S SAME=0
  1.  S START=$P(TEMP,U,2)
  1.  S END=$P(TEMP,U,3)
  1.  I FILENUM=0 D
  1.  . D RTNLD^PXRMEXIC(PXRMRIEN,START,END,.ATTR,.RTN)
  1.  . I EXISTS D
  1.  .. D CHECKSUM^PXRMEXCS(.ATTR,START,END)
  1.  .. S CSUM=$$RTNCS^PXRMEXCS(ATTR("NAME"))
  1.  .. I ATTR("CHECKSUM")=CSUM S SAME=1,ACTION="S"
  1.  . S ^TMP("PXRMEXIA",$J,IND,"ROUTINE",ATTR("NAME"),ACTION)=""
  1.  E  D
  1.  . S TEMP=^PXD(811.8,PXRMRIEN,100,START,0)
  1.  . S PT01=$P(TEMP,"~",2)
  1.  .;Save reminder name for dialog install.
  1.  . ;I FILENUM=811.9 S REMNAME=PT01
  1.  . D SETATTR^PXRMEXFI(.ATTR,FILENUM,PT01)
  1.  . I EXISTS D
  1.  .. D CHECKSUM^PXRMEXCS(.ATTR,START,END)
  1.  .. S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),EXISTS)
  1.  .. I ATTR("CHECKSUM")=CSUM S SAME=1,ACTION="S"
  1.  .;Save what was done for the installation summary.
  1.  . S ^TMP(HISTSUB,$J,IND,ATTR("FILE NAME"),PT01,ACTION)=""
  1.  ;If the packed component and the installed component are the same
  1.  ;there is nothing to do.
  1.  I SAME Q
  1.  ;Install this component.
  1.  I FILENUM=0 D RTNSAVE^PXRMEXIC(.RTN,ATTR("NAME"))
  1.  E  D FILE^PXRMEXIC(PXRMRIEN,EXISTS,IND120,JND120,ACTION,.ATTR,.PXRMNMCH)
  1.  Q
  1.  ;
  1.  ;=======================================
  1. INSDLG(PXRMRIEN,IND120,JND120,ACTION) ;Install dialog components directly
  1.  ;from the "SEL" array.
  1.  N IND,FILENUM,ITEMP,NAME,TEMP
  1.  ;Build the selection array in ^TMP("PXRMEXLD",$J,"SEL"). For dialogs
  1.  ;the selection array is:
  1.  ;file no.^FDA start^FDA end^EXISTS^IND120^JND120^NAME
  1.  S FILENUM=801.41
  1.  D DBUILD^PXRMEXLB(PXRMRIEN,IND120,JND120)
  1.  D BLDDISP^PXRMEXDB(0)
  1.  ;Work through the selection array installing the dialog parts
  1.  ;in reverse order.
  1.  S IND=""
  1.  F  S IND=$O(^TMP("PXRMEXLD",$J,"SEL",IND),-1) Q:(IND="")!(PXRMDONE)  D
  1.  . S TEMP=^TMP("PXRMEXLD",$J,"SEL",IND)
  1.  . S FILENUM=$P(TEMP,U,1),NAME=$P(TEMP,U,7)
  1.  .;Dialog elements may be used more than once in a dialog so make sure
  1.  .;the element has not already been installed.
  1.  . S ITEMP=$P(TEMP,U,1)_U_$P(TEMP,U,4,5)_U_$$EXISTS^PXRMEXIU(FILENUM,NAME)
  1.  . D INSCOM(PXRMRIEN,ACTION,IND,ITEMP,"PXRMEXIAD")
  1.  Q
  1.  ;
  1.  ;=======================================
  1. INSTALL(PXRMRIEN,ACTION,NOCF,NOR) ;Install all components in a repository entry.
  1.  ;If NOCF is true do not install computed findings, if NOR is true
  1.  ;do not install routines.
  1.  N CLOK,DNAME,FILENUM,IND,PXRMDONE,PXRMNAT,PXRMNMCH,REMNAME,TEMP,RNAME
  1.  ;Get the Exchange entry's class.
  1.  S PXRMNAT=$$EXCLASS^PXRMEXU2(PXRMRIEN)
  1.  S PXRMNAT=1
  1.  S PXRMDONE=0
  1.  S NOCF=$G(NOCF),NOR=$G(NOR)
  1.  ;Initialize ^TMP globals.
  1.  D INITMPG^PXRMEXLM
  1.  ;Build the component list.
  1.  K ^PXD(811.8,PXRMRIEN,100,"B")
  1.  K ^PXD(811.8,PXRMRIEN,120)
  1.  D CLIST^PXRMEXCO(PXRMRIEN,.CLOK)
  1.  I 'CLOK Q
  1.  ;Build the selectable list.
  1.  D CDISP^PXRMEXLC(PXRMRIEN)
  1.  ;Set the install type.
  1.  S ^TMP("PXRMEXIA",$J,"TYPE")="SILENT"
  1.  ;Initialize the name change storage.
  1.  K PXRMNMCH
  1.  S IND=0
  1.  F  S IND=$O(^TMP("PXRMEXLC",$J,"SEL",IND)) Q:(IND="")!(PXRMDONE)  D
  1.  . S TEMP=^TMP("PXRMEXLC",$J,"SEL",IND)
  1.  . S FILENUM=$P(TEMP,U,1)
  1.  .;If NOCF is true do not install computed findings.
  1.  . I FILENUM=811.4,NOCF Q
  1.  .;If NOR is true do not install routines.
  1.  . I FILENUM=0,NOR Q
  1.  . ;Install dialog components
  1.  . I FILENUM=801.41 D  Q
  1.  .. N IND120,JND120,PXRMDONE
  1.  .. S IND120=$P(TEMP,U,2),JND120=$P(TEMP,U,3),PXRMDONE=0
  1.  .. D INSDLG(PXRMRIEN,IND120,JND120,ACTION)
  1.  . ;Install component
  1.  . E  D INSCOM(PXRMRIEN,ACTION,IND,TEMP,"PXRMEXIA")
  1.  ;
  1.  ;Get the dialog name
  1.  S DNAME="" F  S DNAME=$O(^TMP("PXRMEXDL",$J,DNAME)) Q:DNAME=""  D
  1.  . S RNAME=""
  1.  . F  S RNAME=$O(^TMP("PXRMEXDL",$J,DNAME,RNAME)) Q:RNAME=""  D
  1.  ..;Link the dialog if it exists
  1.  .. N DIEN,RIEN
  1.  ..;Get the dialog IEN.
  1.  .. S DIEN=$$EXISTS^PXRMEXIU(801.41,DNAME) Q:'DIEN
  1.  ..;Get the reminder IEN.
  1.  .. S RIEN=+$$EXISTS^PXRMEXIU(811.9,$G(RNAME)) Q:'RIEN
  1.  .. N DA,DIE,DIK,DR
  1.  ..;Set reminder to dialog pointer.
  1.  .. S DR="51///^S X=DNAME",DIE="^PXD(811.9,",DA=RIEN
  1.  .. D ^DIE
  1.  ;
  1.  I $D(^TMP("PXRM DIALOG LINK FILE",$J))>0 D DLINKSET^PXRMEXU5
  1.  ;Save the install history.
  1.  D SAVHIST^PXRMEXU1
  1.  ;If any components were skipped send the message.
  1.  I $D(^TMP("PXRMEXNI",$J)) D
  1.  . N NE,XMSUB
  1.  . S NE=$O(^TMP("PXRMEXNI",$J,""),-1)+1
  1.  . S ^TMP("PXRMEXNI",$J,NE,0)="Please review and make changes as necessary."
  1.  . K ^TMP("PXRMXMZ",$J)
  1.  . M ^TMP("PXRMXMZ",$J)=^TMP("PXRMEXNI",$J)
  1.  . S XMSUB="COMPONENTS SKIPPED DURING SILENT MODE INSTALL"
  1.  . D SEND^PXRMMSG("PXRMXMZ",XMSUB,"",DUZ)
  1.  ;Cleanup TMP globals.
  1.  D INITMPG^PXRMEXLM
  1.  Q
  1.  ;
  1.  ;=======================================
  1. LDARRAY(MODE,ENTRY,ROUTINE,ARRAY) ;Load ARRAY with
  1.  ;MODE is a string that may contain any of the following:
  1.  ; A = include action, stored in the third column of the ARRAY entry.
  1.  ; I = include in build, used for the data screen in the KIDS build.
  1.  ; If MODE contains I then the date and time are stored in the second
  1.  ; column of the ARRAY entry.
  1.  ; L = load action, store the name in the first column of the ARRAY
  1.  ; entry. This is the default and both A and I imply L.
  1.  ;ENTRY is the entry point in ROUTINE which is called to populate
  1.  ;ARRAY.
  1.  N RTN
  1.  S RTN=ENTRY_"^"_ROUTINE_"(MODE,.ARRAY)"
  1.  D @RTN
  1.  Q
  1.  ;
  1.  ;=======================================
  1. SMEXINS(ENTRY,ROUTINE) ;Silent mode install.
  1.  N ACTION,EXARRAY,FMTSTR,IC,IEN,LUVALUE,NOUT,NTI,PXRMINST,TEXT,TEXTOUT
  1.  S PXRMINST=1
  1.  D LDARRAY^PXRMEXSI("IA",ENTRY,ROUTINE,.EXARRAY)
  1.  S NTI=$O(EXARRAY(""),-1),NTI=$L(NTI)+1
  1.  S FMTSTR=NTI_"R1^"_(77-NTI)_"L"
  1.  S IC=0
  1.  F  S IC=$O(EXARRAY(IC)) Q:'IC  D
  1.  . S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(2)=EXARRAY(IC,2)
  1.  . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
  1.  . I IEN=0 Q
  1.  . S TEXT=IC_".^Installing Reminder Exchange entry "_LUVALUE(1)
  1.  . K TEXTOUT
  1.  . D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NOUT,.TEXTOUT)
  1.  . D MES^XPDUTL(.TEXTOUT)
  1.  . S ACTION=EXARRAY(IC,3)
  1.  . D INSTALL^PXRMEXSI(IEN,ACTION,1,1)
  1.  Q
  1.  ;