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

PXRMP10I.m

Go to the documentation of this file. 
  1. PXRMP10I ; SLC/PKR - PXRM*2.0*10 init routine. ;09/28/2007
  1.  ;;2.0;CLINICAL REMINDERS;**10**;Feb 04, 2005;Build 25
  1.  Q
  1.  ;
  1. DELEI ;If the Exchange File entry already exists delete it.
  1.  N ARRAY,IC,IND,LIST,LUVALUE,NUM
  1.  D EXARRAY("L",.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. DITEMAR(DIEN,ARRAY) ;
  1.  ;DIEN is the IEN of the dialog top level
  1.  ;Array contains the dialog elements and groups within the dialog.
  1.  N CNT,IEN,REPIEN,TYPE
  1.  S CNT=0 F  S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0  D
  1.  .S IEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2) Q:IEN'>0
  1.  .S REPIEN=$P($G(^PXRMD(801.41,IEN,49)),U,3)
  1.  .I REPIEN>0 D DITEMAR(REPIEN,.ARRAY)
  1.  .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
  1.  .I TYPE="G"!(TYPE="E") D DITEMAR(IEN,.ARRAY)
  1.  .I '$D(ARRAY(IEN)) S ARRAY(IEN)=""
  1.  I '$D(ARRAY(DIEN)) S ARRAY(DIEN)=""
  1.  Q
  1.  ;
  1. DMAKENAT(DA) ;
  1.  N CLASS,DIE,DR,IEN,NAME,NEWNAME,PREFIX,TYPE
  1.  S NAME=$P($G(^PXRMD(801.41,DA,0)),U)
  1.  I $E(NAME,1,3)="VA-"!($E(NAME,1,4)="PXRM") Q
  1.  S CLASS="N"
  1.  S DIE="^PXRMXD(801.41,"
  1.  S DR="100////^S X=CLASS"
  1.  D ^DIE
  1.  S TYPE=$P($G(^PXRMD(801.41,DA,0)),U,4)
  1.  S PREFIX=$S(TYPE="R":"VA-",TYPE="G":"VA-",TYPE="E":"VA-",1:"PXRM ")
  1.  S NEWNAME=PREFIX_NAME
  1.  D RENAME(801.41,NAME,NEWNAME)
  1.  Q
  1.  ;
  1. EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
  1.  N CNT
  1.  S CNT=0
  1.  ;
  1.  S CNT=CNT+1,ARRAY(CNT,1)="VA-VANOD SKIN ASSESSMENT"
  1.  I MODE["I" S ARRAY(CNT,2)="07/16/2007@14:45:37"
  1.  I MODE["A" S ARRAY(CNT,3)="O"
  1.  ;
  1.  S CNT=CNT+1,ARRAY(CNT,1)="VA-VANOD SKIN REASSESSMENT"
  1.  I MODE["I" S ARRAY(CNT,2)="07/16/2007@14:46:02"
  1.  I MODE["A" S ARRAY(CNT,3)="O"
  1.  ;
  1.  S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS TYPES"
  1.  I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:20:09"
  1.  I MODE["A" S ARRAY(CNT,3)="O"
  1.  ;
  1.  S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS OBJECTS"
  1.  I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:21:13"
  1.  I MODE["A" S ARRAY(CNT,3)="O"
  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 EXARRAY,FOUND,IEN,IC,LUVALUE
  1.  D EXARRAY("I",.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. NATCONV ;
  1.  N ARRAY,CLASS,CNT,DA,DIE,DIEN,DR,IEN,NAME,PXRMEXCH,PXRMINST,RIEN
  1.  S PXRMEXCH=1,PXRMINST=1,CLASS="N"
  1.  F NAME="VANOD SKIN ASSESSMENT","VANOD SKIN REASSESSMENT" D
  1.  .S RIEN=$O(^PXD(811.9,"B",NAME,"")) Q:RIEN'>0
  1.  .S DA=RIEN,DIE="^PXD(811.9,",DR="100///^S X=CLASS"
  1.  .D ^DIE
  1.  .D RENAME(811.9,NAME,"VA-"_NAME)
  1.  .S DIEN=$P($G(^PXD(811.9,RIEN,51)),U) Q:DIEN'>0
  1.  .D DITEMAR(DIEN,.ARRAY)
  1.  .S IEN=0 F  S IEN=$O(ARRAY(IEN)) Q:IEN'>0  D
  1.  ..D DMAKENAT(IEN)
  1.  .D DMAKENAT(DIEN)
  1.  Q
  1.  ;
  1. PRE ;
  1.  D DELEI
  1.  D NATCONV
  1.  Q
  1.  ;
  1. POST ;
  1.  D SMEXINS
  1.  Q
  1.  ;
  1. RENAME(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
  1.  ;file number FILENUM.
  1.  N DA,DIE,DR,NIEN
  1.  S NIEN=$$FIND1^DIC(FILENUM,"","BX",NEWNAME) I NIEN>0 Q
  1.  S DA=$$FIND1^DIC(FILENUM,"","BX",OLDNAME)
  1.  I DA=0 Q
  1.  S DIE=FILENUM
  1.  S DR=".01///^S X=NEWNAME"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. SENDDLG(IEN) ;
  1.  N NAME
  1.  S NAME=$P($G(^PXRMD(801.41,IEN,0)),U)
  1.  I NAME="PXRM BRADEN 6-8" Q 1
  1.  I NAME="PXRM BRADEN 10-12" Q 1
  1.  I NAME="PXRM BRADEN 13-14" Q 1
  1.  I NAME="PXRM BRADEN 15-18" Q 1
  1.  I NAME="PXRM BRADEN 19-23" Q 1
  1.  I NAME="PXRM VANOD PU LOCATIONS" Q 1
  1.  I NAME="PXRM VANOD SKIN COLOR" Q 1
  1.  I NAME="PXRM VANOD SKIN MOISTURE" Q 1
  1.  I NAME="PXRM VANOD SKIN TEMP" Q 1
  1.  I NAME="PXRM VANOD SKIN TURGOR" Q 1
  1.  I NAME="PXRM VANOD DATE FORCED TODAY" Q 1
  1.  Q 0
  1.  ;
  1. SMEXINS ;Silent mode install
  1.  N ACTION,EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT
  1.  S PXRMINST=1
  1.  D EXARRAY("IA",.EXARRAY)
  1.  S IC=0
  1.  F  S IC=$O(EXARRAY(IC)) Q:'IC  D
  1.  .I EXARRAY(IC,1)["GMTS" Q
  1.  .S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(IC,2)=EXARRAY(IC,2)
  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.  .. I $$PATCH^XPDUTL("PXRM*2.0*6") D
  1.  ... S ACTION=EXARRAY(IC,3)
  1.  ... D INSTALL^PXRMEXSI(IEN,ACTION,1)
  1.  .. I '$$PATCH^XPDUTL("PXRM*2.0*6") D INSTALL^PXRMEXSI(IEN,1)
  1.  Q
  1.  ;