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.;10/23/2020
  1. ;;2.0;CLINICAL REMINDERS;**6,12,16,26,45,42**;Feb 04, 2005;Build 245
  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. PATTR(IEN) ;Build the Packing Attribute list.
  1. N ATTRLIST,DONE,FDA,IENS,INDEXAT,LN,MSG,NATTR,TEXT
  1. S TEXT=^PXD(811.8,IEN,100,4,0)
  1. S INDEXAT=$$GETTAGV^PXRMEXU3(TEXT,"<INDEX_AT>",10)
  1. S (DONE,NATTR)=0
  1. S LN=10
  1. F Q:DONE D
  1. . S LN=LN+1
  1. . I LN=INDEXAT S DONE=1 Q
  1. . S TEXT=^PXD(811.8,IEN,100,LN,0)
  1. . I TEXT["</ATTRIBUTE>" S NATTR=NATTR+1,ATTRLIST(NATTR)=$$GETTAGV^PXRMEXU3(TEXT,"<ATTRIBUTE>",11)
  1. . I TEXT["</PACKING ATTRIBUTES>" S DONE=1 Q
  1. I NATTR=0 S NATTR=1,ATTRLIST(1)="NONE"
  1. F LN=1:1:NATTR D
  1. . S IENS="+"_LN_","_IEN_","
  1. . S FDA(811.805,IENS,.01)=ATTRLIST(LN)
  1. D UPDATE^DIE("S","FDA","","MSG")
  1. I $D(MSG) D
  1. . K TEXT
  1. . S TEXT(1)="Storage of the Packing Attributes failed."
  1. . S TEXT(2)="Examine the following error message for the reason."
  1. . S TEXT(3)=""
  1. . S TEXT(4)="The update failed, UPDATE^DIE returned the following error message:"
  1. . D MES^XPDUTL(.TEXT)
  1. . D AWRITE^PXRMUTIL("MSG")
  1. Q
  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. TIUSRCH(GLOB,IEN,NODE,OLIST,TLIST) ;Extract TIU Objects/Templates
  1. ;from any WP text.
  1. N NIN,NOUT,OCNT,SUB,TCNT,TEXT,TEXTIN,TEXTOUT
  1. ;Add to existing arrays
  1. S NIN=0
  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. .S NIN=NIN+1
  1. .S TEXTIN(NIN)=TEXT
  1. D FORMAT^PXRMTEXT(0,80,NIN,.TEXTIN,.NOUT,.TEXTOUT)
  1. F X=1:1:NOUT D
  1. .S TEXT=TEXTOUT(X)
  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. ;=====================================================
  1. TIUXTR(SRCH,SRCH1,TEXT,OUTPUT,CNT) ;
  1. N EXIST,IC,ONAME,TMP,TXT
  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. .I SRCH1="}" S TMP=$P(TXT,SRCH1,2) I $E(TMP,1,3)="FMT" Q
  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. ;