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

PXRMEXU2.m

Go to the documentation of this file.
  1. PXRMEXU2 ; SLC/PKR/PJH - Reminder exchange repository utilities, #2.;07/02/2020
  1. ;;2.0;CLINICAL REMINDERS;**6,12,26,45,74**;Feb 04, 2005;Build 5
  1. ;=================================
  1. EXCLASS(IEN) ;Return the class of the Exchange entry.
  1. N ENV,TEMP
  1. ;If the Environment has been saved it will be on line 9.
  1. S TEMP=^PXD(811.8,IEN,100,9,0)
  1. S ENV=$S(TEMP["<ENV>":$$GETTAGV^PXRMEXU3(TEMP,"<ENV>",0),1:"")
  1. ;If ENV was not found on line 9 search for it.
  1. I ENV="" D
  1. . N IND
  1. . S TEMP=""
  1. . F IND=1:1 Q:(ENV'="")!(TEMP["</SOURCE>") D
  1. .. S TEMP=^PXD(811.8,IEN,100,IND,0)
  1. .. I TEMP["<ENV>" S ENV=$$GETTAGV^PXRMEXU3(TEMP,"<ENV>",0)
  1. Q $S($P(ENV,U,1)="NATREM":1,$G(PXRMINST)=1:1,$D(XPDNM):1,1:0)
  1. ;
  1. ;=================================
  1. FDA(IND,LC,TMPIND,FILENAME) ;Build the XML FDA output.
  1. N FIELD,FILENUM,INDEX,INDEX0,JND,SIENS,WPC
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FDA>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
  1. ;Get the file number.
  1. S FILENUM=""
  1. F S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM)) Q:FILENUM="" D
  1. .;Get the source IEN string.
  1. . S SIENS=""
  1. . F S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS)) Q:SIENS="" D
  1. .. S INDEX0=FILENUM_";"_SIENS
  1. ..;Get the field number and store the data.
  1. .. S FIELD=""
  1. .. F S FIELD=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)) Q:FIELD="" D
  1. ... S INDEX=INDEX0_";"_FIELD
  1. ...;If there is another index past the field then this is a
  1. ...;word-processing field.
  1. ... I $D(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD))=11 D
  1. .... S WPC=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,""),-1)
  1. .... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~WP-start~"_WPC
  1. .... F JND=1:1:WPC D
  1. ..... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,JND)
  1. ... E S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~"_^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FDA>"
  1. Q
  1. ;
  1. ;=================================
  1. IENROOT(IND,LC,TMPIND,FILENAME) ;Build the XML IEN_ROOT output.
  1. N INDEX,VALUE
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<IEN_ROOT>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
  1. S INDEX=0
  1. F S INDEX=$O(^TMP(TMPIND,$J,IND,FILENAME,INDEX)) Q:INDEX="" D
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_U_^TMP(TMPIND,$J,IND,FILENAME,INDEX)
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</IEN_ROOT>"
  1. Q
  1. ;
  1. ;=================================
  1. MLWARN(FILENAME,PT01,IEN,LINE,MAXLEN) ;Issue a warning if the length of the
  1. ;line exceeds the maximum allowed value.
  1. N DATA,INDICES,FIELD,LEN,TEXT
  1. S LEN=$L(LINE)
  1. S INDICES=$P(LINE,"~",1)
  1. S FIELD=$P(INDICES,";",3)
  1. S DATA=$P(LINE,"~",2)
  1. S TEXT(1)="Warning the following line exceeds the VistA maximum allowed length of "_MAXLEN_"."
  1. S TEXT(2)="Therefore this Exchange entry will not transport correctly."
  1. S TEXT(3)="Line: "_LINE
  1. S TEXT(4)="Its length is: "_LEN
  1. S TEXT(5)="Component: "_FILENAME
  1. S TEXT(6)="Name: "_PT01
  1. S TEXT(7)="IEN: "_IEN
  1. S TEXT(8)="Field number: "_FIELD
  1. S TEXT(9)="Value: "_DATA
  1. S TEXT(10)=""
  1. D EN^DDIOL(.TEXT)
  1. H 2
  1. Q
  1. ;
  1. ;=================================
  1. PATTR(IEN,ATTR) ;If the Reminder Exchange entry has the packing attribute
  1. ;ATTR return 1 otherwise return 0.
  1. I $D(^PXD(811.8,IEN,140,"B",ATTR)) Q 1
  1. Q 0
  1. ;
  1. ;=================================
  1. STOREPR(SUCCESS,EFNAME,TMPIND,SELLIST) ;^TMP(TMPIND,$J contains data to be
  1. ;stored in the repository. Routines will be found in
  1. ;^TMP(TMPIND,$J,"ROUTINE",ROUTINE NAME,n) where n is the line number.
  1. ;File entries will be found in ^TMP(TMPIND,$J,N,FILENAME,indexes).
  1. ;This is output from the GETS^DIQ call. There are NUMF file entries.
  1. ;Format and store it as XML in the repository.
  1. N DATE,DTEST,FDA,FILENAME,FILENUM,IEN
  1. N IENROOT,IND,JND,LC,LINE,NCMPNT,NEWFILE,NUMF,PT01,RNAME
  1. N SIENS,SOURCE,TEMP,VERSN
  1. ;If anything went wrong in the packing process then ^TMP(TMPIND,$J
  1. ;will not exist.
  1. I '$D(^TMP(TMPIND,$J)) S SUCCESS=0 Q
  1. ;
  1. K ^TMP($J,"CIND")
  1. K ^TMP("PXRMEXRS",$J)
  1. S ^TMP("PXRMEXRS",$J,1,0)="<?xml version=""1.0"" standalone=""yes""?>"
  1. S ^TMP("PXRMEXRS",$J,2,0)="<REMINDER_EXCHANGE_FILE_ENTRY>"
  1. S VERSN=$P(^PXRM(800,1,"VERSION"),U,1)
  1. S ^TMP("PXRMEXRS",$J,3,0)="<PACKAGE_VERSION>"_VERSN_"</PACKAGE_VERSION>"
  1. ;The pointer to the index will be on line 4 so leave room.
  1. S LC=4
  1. ;Save the source information.
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SOURCE>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NAME>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","NAME"))_"</NAME>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<USER>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","USER"))_"</USER>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SITE>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","SITE"))_"</SITE>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ENV>"_^TMP(TMPIND,$J,"SRC","ENV")_"</ENV>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DATE_PACKED>"_^TMP(TMPIND,$J,"SRC","DATE")_"</DATE_PACKED>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</SOURCE>"
  1. ;
  1. ;Save the description.
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DESCRIPTION><![CDATA["
  1. S IND=0
  1. F S IND=$O(^TMP(TMPIND,$J,"DESC",1,IND)) Q:+IND=0 D
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"DESC",1,IND,0)
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]></DESCRIPTION>"
  1. ;
  1. ;Save the keywords or phrases.
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORDS>"
  1. S IND=0
  1. F S IND=$O(^TMP(TMPIND,$J,"KEYWORD",1,IND)) Q:+IND=0 D
  1. . S TEMP=^TMP(TMPIND,$J,"KEYWORD",1,IND,0)
  1. . I TEMP["," D
  1. .. F JND=1:1:$L(TEMP,",") D
  1. ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3($P(TEMP,",",JND))_"</KEYWORD>"
  1. . E S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3(TEMP)_"</KEYWORD>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</KEYWORDS>"
  1. ;
  1. ;Save the packing attributes.
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<PACKING ATTRIBUTES><![CDATA["
  1. S IND=0
  1. F S IND=$O(^TMP(TMPIND,$J,"PATTR",IND)) Q:+IND=0 D
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ATTRIBUTE>"_^TMP(TMPIND,$J,"PATTR",IND)_"</ATTRIBUTE>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]></PACKING ATTRIBUTES>"
  1. ;
  1. S NCMPNT=0
  1. ;Do routines first.
  1. S RNAME=""
  1. F S RNAME=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME)) Q:RNAME="" D
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<M_ROUTINE>"
  1. . S NCMPNT=NCMPNT+1
  1. . S ^TMP($J,"CIND",NCMPNT,"M_ROUTINE_START")=LC
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ROUTINE_NAME>"_RNAME_"</ROUTINE_NAME>"
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,"ROUTINE",RNAME)_"</CHECKSUM>"
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CODE>"
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
  1. . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_START")=LC+1
  1. . S LINE=0
  1. . F S LINE=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE)) Q:LINE="" D
  1. .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE,0)
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</CODE>"
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</M_ROUTINE>"
  1. . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_END")=LC-3
  1. ;
  1. ;Do file entries. For word processing fields the first line is
  1. ;file number;source ien string;field~WP-start~line count
  1. ;The next line count lines are the WP data.
  1. S NUMF=+$G(^TMP(TMPIND,$J,"NUMF"))
  1. S FILENAME=""
  1. F IND=1:1:NUMF D
  1. . F S FILENAME=$O(^TMP(TMPIND,$J,IND,FILENAME)) Q:FILENAME="" D
  1. .. I FILENAME["IENROOT" S NEWFILE=0,IENROOT=1
  1. .. E S NEWFILE=1,IENROOT=0
  1. .. I NEWFILE D
  1. ... S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,""))
  1. ... S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,""))
  1. ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FILE>"
  1. ... S NCMPNT=NCMPNT+1
  1. ... S ^TMP($J,"CIND",NCMPNT,"FILE_START")=LC
  1. ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NAME>"_$$TOXML^PXRMEXU3(FILENAME)_"</FILE_NAME>"
  1. ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NUMBER>"_FILENUM_"</FILE_NUMBER>"
  1. ... S LC=LC+1,PT01=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,.01)
  1. ... S ^TMP("PXRMEXRS",$J,LC,0)="<POINT_01>"_$$TOXML^PXRMEXU3(PT01)_"</POINT_01>"
  1. ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<INTERNAL_ENTRY_NUMBER>"_+SIENS_"</INTERNAL_ENTRY_NUMBER>"
  1. ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,IND,FILENAME)_"</CHECKSUM>"
  1. ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SELECTED>"_$S($D(SELLIST(FILENUM,"IEN",+SIENS)):"YES",1:"NO")_"</SELECTED>"
  1. ... S ^TMP($J,"CIND",NCMPNT,"FDA_START")=LC+3
  1. ... D FDA(IND,.LC,TMPIND,FILENAME)
  1. ... S ^TMP($J,"CIND",NCMPNT,"FDA_END")=LC-2
  1. ..;The ien root information always comes after the FDA.
  1. .. I IENROOT D
  1. ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_START")=LC+3
  1. ... D IENROOT(IND,.LC,TMPIND,FILENAME)
  1. ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_END")=LC-2
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FILE>"
  1. ;Save the index.
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,4,0)="<INDEX_AT>"_LC_"</INDEX_AT>"
  1. S ^TMP("PXRMEXRS",$J,LC,0)="<INDEX>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NUMBER_OF_COMPONENTS>"_NCMPNT_"</NUMBER_OF_COMPONENTS>"
  1. F IND=1:1:NCMPNT D
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<COMPONENT>"
  1. . S JND=""
  1. . F S JND=$O(^TMP($J,"CIND",IND,JND)) Q:JND="" D
  1. .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<"_JND_">"_^TMP($J,"CIND",IND,JND)_"</"_JND_">"
  1. . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</COMPONENT>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</INDEX>"
  1. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</REMINDER_EXCHANGE_FILE_ENTRY>"
  1. ;Establish the entry in the repository.
  1. S SOURCE=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
  1. S DATE=^TMP(TMPIND,$J,"SRC","DATE")
  1. S FDA(811.8,"+1,",.01)=EFNAME
  1. S FDA(811.8,"+1,",.02)=SOURCE
  1. S FDA(811.8,"+1,",.03)=DATE
  1. D UPDATE^PXRMEXPU(.SUCCESS,.FDA,.IENROOT)
  1. I SUCCESS D
  1. . M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXRS",$J)
  1. .;Set the 0 node.
  1. . S ^PXD(811.8,IENROOT(1),100,0)=U_811.801_U_LC_U_LC
  1. .;Create the description for this repository entry.
  1. . N DESC,DESL,KEYWORD
  1. . S DESL("SOURCE")=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
  1. . S DESL("DATEP")=^TMP(TMPIND,$J,"SRC","DATE")
  1. . S DESL("VRSN")=VERSN
  1. . S DESC="^TMP(TMPIND,$J,""DESC"")"
  1. . S KEYWORD="^TMP(TMPIND,$J,""KEYWORD"")"
  1. . D DESC^PXRMEXU1(IENROOT(1),.DESL,$NA(@DESC),$NA(@KEYWORD))
  1. . F IND=1:1:LC D
  1. .. S LINE=^TMP("PXRMEXRS",$J,IND,0)
  1. .. I LINE["<FILE_NAME>" S FILENAME=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
  1. .. I LINE["<POINT_01>" S PT01=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
  1. .. I LINE["<INTERNAL_ENTRY_NUMBER>" S IEN=$$GETTAGV^PXRMEXU3(LINE,"<INTERNAL_ENTRY_NUMBER>",1)
  1. ..;Use 1024 to be conservative.
  1. .. I $L(LINE)<1025 Q
  1. .. D MLWARN(FILENAME,PT01,IEN,LINE,1024)
  1. K ^TMP($J,"CIND"),^TMP("PXRMEXRS",$J)
  1. K ^TMP(TMPIND,$J),^TMP("PXRMEXCS",$J)
  1. Q
  1. ;
  1. ;=================================
  1. XMLOUT(IEN) ;Write out the XML content of repository entry ien.
  1. N LC,NLINES
  1. S NLINES=$O(^PXD(811.8,IEN,100,""),-1)
  1. F LC=1:1:NLINES W !,^PXD(811.8,IEN,100,LC,0)
  1. Q
  1. ;