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

PXRMEXU1.m

Go to the documentation of this file. 
  1. PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1.;01/22/2013
  1.  ;;2.0;CLINICAL REMINDERS;**6,12,16,26**;Feb 04, 2005;Build 404
  1.  ;=====================================================
  1. DELETE(LIST) ;Delete the repository entries in LIST.
  1.  N DA,DIK,IND,LNUM
  1.  S DIK="^PXD(811.8,"
  1.  F IND=1:1:$L(LIST,",")-1 D
  1.  . S LNUM=$P(LIST,",",IND)
  1.  . S DA=$$RIEN^PXRMEXU1(LNUM)
  1.  . D ^DIK
  1.  Q
  1.  ;
  1.  ;=====================================================
  1. DELHIST(RIEN,IHIEN) ;Delete install history IHIEN in repository entry RIEN.
  1.  N DA,DIK
  1.  S DA=IHIEN,DA(1)=RIEN
  1.  S DIK="^PXD(811.8,"_DA(1)_",130,"
  1.  D ^DIK
  1.  Q
  1.  ;
  1.  ;=====================================================
  1. DESC(RIEN,DESL,DESC,KEYWORD) ;Build the description.
  1.  N JND,LC,NKEYWL
  1.  S LC=1,^PXD(811.8,RIEN,110,LC,0)="Source:      "_DESL("SOURCE")
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Date Packed: "_DESL("DATEP")
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Package Version: "_DESL("VRSN")
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=""
  1.  ;Add the user's description.
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Description:"
  1.  F JND=1:1:+$P($G(@DESC@(1,0)),U,4) D
  1.  . S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=@DESC@(1,JND,0)
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=""
  1.  ;Add the keywords.
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Keywords:"
  1.  S NKEYWL=+$P($G(@KEYWORD@(1,0)),U,4)
  1.  F JND=1:1:NKEYWL D
  1.  . S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=@KEYWORD@(1,JND,0)
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)=""
  1.  S LC=LC+1,^PXD(811.8,RIEN,110,LC,0)="Components:"
  1.  S ^PXD(811.8,RIEN,110,0)=U_811.804_U_LC_U_LC
  1.  Q
  1.  ;
  1.  ;=====================================================
  1. RIEN(LNUM) ;Given the list number return the repository ien.
  1.  N RIEN
  1.  S RIEN=$G(^TMP("PXRMEXLR",$J,"SEL",LNUM))
  1.  Q RIEN
  1.  ;
  1.  ;=====================================================
  1. SAVHIST ;Save the installation history in the repository.
  1.  N ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,KND,NEWNAME
  1.  N SUB,TEMP,TOTAL,TYPE,USER
  1.  ;Find the first open spot in the Installation History node.
  1.  S (IND,JND)=0
  1.  F  S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(IND>JND)
  1.  S IND=JND
  1.  S JND=0
  1.  F SUB="PXRMEXIA","PXRMEXIAD" D
  1.  . S INDEX=0
  1.  . F  S INDEX=$O(^TMP(SUB,$J,INDEX)) Q:+INDEX=0  D
  1.  .. S JND=JND+1
  1.  .. S CMPNT=$O(^TMP(SUB,$J,INDEX,""))
  1.  .. S ITEM=$O(^TMP(SUB,$J,INDEX,CMPNT,""))
  1.  .. S ACTION=$O(^TMP(SUB,$J,INDEX,CMPNT,ITEM,""))
  1.  .. S NEWNAME=$G(^TMP(SUB,$J,INDEX,CMPNT,ITEM,ACTION))
  1.  .. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME
  1.  ..;Set the 0 node.
  1.  .. S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND
  1.  ..;Check for finding item changes and save them.
  1.  .. S FTYPE=""
  1.  .. I CMPNT["DEFINITION" S FTYPE="DEFF"
  1.  .. I CMPNT["DIALOG" S FTYPE="DIAF"
  1.  .. I CMPNT["TERM" S FTYPE="TRMF"
  1.  .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
  1.  ... N FI,FINDING,OFINDING
  1.  ... S KND=2
  1.  ... S FI=""
  1.  ... F  S FI=$O(^TMP(SUB,$J,FTYPE,FI)) Q:FI=""  D
  1.  .... S OFINDING=$O(^TMP(SUB,$J,FTYPE,FI,""))
  1.  .... S FINDING=^TMP(SUB,$J,FTYPE,FI,OFINDING)
  1.  .... I OFINDING=FINDING Q
  1.  .... S KND=KND+1
  1.  .... S TEMP=$E(OFINDING,1,33)
  1.  .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)="    "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING
  1.  ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
  1.  ... I KND>2 D
  1.  .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)="   Finding Changes"
  1.  .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)="     Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
  1.  ..;
  1.  ..;Check for TIU template replacements and save them.
  1.  .. I CMPNT["DIALOG" S FTYPE="DIATIU"
  1.  .. E  S FTYPE=""
  1.  .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D
  1.  ... N OTIUT,TIUT,TYPE
  1.  ... S TYPE=""
  1.  ... S KND=2
  1.  ... F  S TYPE=$O(^TMP(SUB,$J,FTYPE,TYPE)) Q:TYPE=""  D
  1.  .... S OTIUT=""
  1.  .... F  S OTIUT=$O(^TMP(SUB,$J,FTYPE,TYPE,OTIUT)) Q:OTIUT=""  D
  1.  ..... S TIUT=$G(^TMP(SUB,$J,FTYPE,TYPE,OTIUT))
  1.  ..... I OTIUT=TIUT Q
  1.  ..... I '$D(^TMP(SUB,$J,FTYPE,TYPE,OTIUT,ITEM)) Q
  1.  ..... S KND=KND+1
  1.  ..... S TEMP=$E(OTIUT,1,33)
  1.  ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)="    "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT
  1.  .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND
  1.  .... I KND>2 D
  1.  ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)="   "_TYPE
  1.  ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)="     Original"_$$INSCHR^PXRMEXLC(27," ")_"New"
  1.  ;If JND is still 0 then there was nothing to save.
  1.  I JND>0 D
  1.  .;Save the header information.
  1.  . S DATE=$$NOW^XLFDT
  1.  . S TYPE=$G(^TMP("PXRMEXIA",$J,"TYPE"))
  1.  . I TYPE="" S TYPE="INTERACTIVE"
  1.  . S USER=$$GET1^DIQ(200,DUZ,.01,"")
  1.  . S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER_U_TYPE
  1.  . S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)=""
  1.  .;Set the 0 node.
  1.  . S (KND,TOTAL)=0
  1.  . F  S KND=+$O(^PXD(811.8,PXRMRIEN,130,KND)) Q:KND=0  S TOTAL=TOTAL+1
  1.  . S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_IND_U_TOTAL
  1.  K ^TMP("PXRMEXIA",$J)
  1.  K ^TMP("PXRMEXIAD",$J)
  1.  Q
  1.  ;
  1.  ;=====================================================
  1.  ;Extract TIU Objects/Templates from any WP text
  1. TIUSRCH(GLOB,IEN,NODE,OLIST,TLIST) ;
  1.  N OCNT,SUB,TCNT,TEXT
  1.  ;Add to existing arrays
  1.  S OCNT=+$O(OLIST(""),-1),TCNT=+$O(TLIST(""),-1),SUB=0
  1.  ;Scan WP fields
  1.  F  S SUB=$O(@(GLOB_IEN_","_NODE_","_SUB_")")) Q:'SUB  D
  1.  .;Get individual line
  1.  .S TEXT=$G(@(GLOB_IEN_","_NODE_","_SUB_",0)")) Q:TEXT=""
  1.  .;Most text lines will have no TIU link so ignore them
  1.  .I (TEXT'["|")&(TEXT'["{FLD:") Q
  1.  .;Templates are in format {FLD:fldname} (only applies to dialogs)
  1.  .I GLOB[801.41 D TIUXTR("{FLD:","}",TEXT,.TLIST,.TCNT)
  1.  .;Objects are in format |Objectname|
  1.  .D TIUXTR("|","|",TEXT,.OLIST,.OCNT)
  1.  Q
  1.  ;
  1. TIUXTR(SRCH,SRCH1,TEXT,OUTPUT,CNT) ;
  1.  N EXIST,IC,TXT,ONAME
  1.  S TXT=TEXT
  1.  F  D  Q:TXT'[SRCH
  1.  .S TXT=$E(TXT,$F(TXT,SRCH),$L(TXT)) Q:TXT'[SRCH1
  1.  .S ONAME=$P(TXT,SRCH1) Q:ONAME=""
  1.  .;
  1.  .;remove the valid item from the text string. This prevent problems
  1.  .;with multiple objects on one line.
  1.  .;
  1.  .S TXT=$P(TXT,ONAME_SRCH1,2)
  1.  .;Check if already selected
  1.  .S EXIST=0,IC=0
  1.  .F  S IC=$O(OUTPUT(IC)) Q:'IC  Q:EXIST  D
  1.  ..I $G(OUTPUT(IC))=ONAME S EXIST=1
  1.  .;Save array of object/template names
  1.  .I 'EXIST S CNT=CNT+1,OUTPUT(CNT)=ONAME
  1.  Q
  1.  ;