- PXRMEXU2 ; SLC/PKR/PJH - Reminder exchange repository utilities, #2.;07/02/2020
- ;;2.0;CLINICAL REMINDERS;**6,12,26,45,74**;Feb 04, 2005;Build 5
- ;=================================
- EXCLASS(IEN) ;Return the class of the Exchange entry.
- N ENV,TEMP
- ;If the Environment has been saved it will be on line 9.
- S TEMP=^PXD(811.8,IEN,100,9,0)
- S ENV=$S(TEMP["<ENV>":$$GETTAGV^PXRMEXU3(TEMP,"<ENV>",0),1:"")
- ;If ENV was not found on line 9 search for it.
- I ENV="" D
- . N IND
- . S TEMP=""
- . F IND=1:1 Q:(ENV'="")!(TEMP["</SOURCE>") D
- .. S TEMP=^PXD(811.8,IEN,100,IND,0)
- .. I TEMP["<ENV>" S ENV=$$GETTAGV^PXRMEXU3(TEMP,"<ENV>",0)
- Q $S($P(ENV,U,1)="NATREM":1,$G(PXRMINST)=1:1,$D(XPDNM):1,1:0)
- ;
- ;=================================
- FDA(IND,LC,TMPIND,FILENAME) ;Build the XML FDA output.
- N FIELD,FILENUM,INDEX,INDEX0,JND,SIENS,WPC
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FDA>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
- ;Get the file number.
- S FILENUM=""
- F S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM)) Q:FILENUM="" D
- .;Get the source IEN string.
- . S SIENS=""
- . F S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS)) Q:SIENS="" D
- .. S INDEX0=FILENUM_";"_SIENS
- ..;Get the field number and store the data.
- .. S FIELD=""
- .. F S FIELD=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)) Q:FIELD="" D
- ... S INDEX=INDEX0_";"_FIELD
- ...;If there is another index past the field then this is a
- ...;word-processing field.
- ... I $D(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD))=11 D
- .... S WPC=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,""),-1)
- .... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~WP-start~"_WPC
- .... F JND=1:1:WPC D
- ..... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD,JND)
- ... E S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_"~"_^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,FIELD)
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FDA>"
- Q
- ;
- ;=================================
- IENROOT(IND,LC,TMPIND,FILENAME) ;Build the XML IEN_ROOT output.
- N INDEX,VALUE
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<IEN_ROOT>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
- S INDEX=0
- F S INDEX=$O(^TMP(TMPIND,$J,IND,FILENAME,INDEX)) Q:INDEX="" D
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=INDEX_U_^TMP(TMPIND,$J,IND,FILENAME,INDEX)
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</IEN_ROOT>"
- Q
- ;
- ;=================================
- MLWARN(FILENAME,PT01,IEN,LINE,MAXLEN) ;Issue a warning if the length of the
- ;line exceeds the maximum allowed value.
- N DATA,INDICES,FIELD,LEN,TEXT
- S LEN=$L(LINE)
- S INDICES=$P(LINE,"~",1)
- S FIELD=$P(INDICES,";",3)
- S DATA=$P(LINE,"~",2)
- S TEXT(1)="Warning the following line exceeds the VistA maximum allowed length of "_MAXLEN_"."
- S TEXT(2)="Therefore this Exchange entry will not transport correctly."
- S TEXT(3)="Line: "_LINE
- S TEXT(4)="Its length is: "_LEN
- S TEXT(5)="Component: "_FILENAME
- S TEXT(6)="Name: "_PT01
- S TEXT(7)="IEN: "_IEN
- S TEXT(8)="Field number: "_FIELD
- S TEXT(9)="Value: "_DATA
- S TEXT(10)=""
- D EN^DDIOL(.TEXT)
- H 2
- Q
- ;
- ;=================================
- PATTR(IEN,ATTR) ;If the Reminder Exchange entry has the packing attribute
- ;ATTR return 1 otherwise return 0.
- I $D(^PXD(811.8,IEN,140,"B",ATTR)) Q 1
- Q 0
- ;
- ;=================================
- STOREPR(SUCCESS,EFNAME,TMPIND,SELLIST) ;^TMP(TMPIND,$J contains data to be
- ;stored in the repository. Routines will be found in
- ;^TMP(TMPIND,$J,"ROUTINE",ROUTINE NAME,n) where n is the line number.
- ;File entries will be found in ^TMP(TMPIND,$J,N,FILENAME,indexes).
- ;This is output from the GETS^DIQ call. There are NUMF file entries.
- ;Format and store it as XML in the repository.
- N DATE,DTEST,FDA,FILENAME,FILENUM,IEN
- N IENROOT,IND,JND,LC,LINE,NCMPNT,NEWFILE,NUMF,PT01,RNAME
- N SIENS,SOURCE,TEMP,VERSN
- ;If anything went wrong in the packing process then ^TMP(TMPIND,$J
- ;will not exist.
- I '$D(^TMP(TMPIND,$J)) S SUCCESS=0 Q
- ;
- K ^TMP($J,"CIND")
- K ^TMP("PXRMEXRS",$J)
- S ^TMP("PXRMEXRS",$J,1,0)="<?xml version=""1.0"" standalone=""yes""?>"
- S ^TMP("PXRMEXRS",$J,2,0)="<REMINDER_EXCHANGE_FILE_ENTRY>"
- S VERSN=$P(^PXRM(800,1,"VERSION"),U,1)
- S ^TMP("PXRMEXRS",$J,3,0)="<PACKAGE_VERSION>"_VERSN_"</PACKAGE_VERSION>"
- ;The pointer to the index will be on line 4 so leave room.
- S LC=4
- ;Save the source information.
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SOURCE>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NAME>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","NAME"))_"</NAME>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<USER>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","USER"))_"</USER>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SITE>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$J,"SRC","SITE"))_"</SITE>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ENV>"_^TMP(TMPIND,$J,"SRC","ENV")_"</ENV>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DATE_PACKED>"_^TMP(TMPIND,$J,"SRC","DATE")_"</DATE_PACKED>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</SOURCE>"
- ;
- ;Save the description.
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<DESCRIPTION><![CDATA["
- S IND=0
- F S IND=$O(^TMP(TMPIND,$J,"DESC",1,IND)) Q:+IND=0 D
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"DESC",1,IND,0)
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]></DESCRIPTION>"
- ;
- ;Save the keywords or phrases.
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORDS>"
- S IND=0
- F S IND=$O(^TMP(TMPIND,$J,"KEYWORD",1,IND)) Q:+IND=0 D
- . S TEMP=^TMP(TMPIND,$J,"KEYWORD",1,IND,0)
- . I TEMP["," D
- .. F JND=1:1:$L(TEMP,",") D
- ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3($P(TEMP,",",JND))_"</KEYWORD>"
- . E S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3(TEMP)_"</KEYWORD>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</KEYWORDS>"
- ;
- ;Save the packing attributes.
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<PACKING ATTRIBUTES><![CDATA["
- S IND=0
- F S IND=$O(^TMP(TMPIND,$J,"PATTR",IND)) Q:+IND=0 D
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ATTRIBUTE>"_^TMP(TMPIND,$J,"PATTR",IND)_"</ATTRIBUTE>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]></PACKING ATTRIBUTES>"
- ;
- S NCMPNT=0
- ;Do routines first.
- S RNAME=""
- F S RNAME=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME)) Q:RNAME="" D
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<M_ROUTINE>"
- . S NCMPNT=NCMPNT+1
- . S ^TMP($J,"CIND",NCMPNT,"M_ROUTINE_START")=LC
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<ROUTINE_NAME>"_RNAME_"</ROUTINE_NAME>"
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,"ROUTINE",RNAME)_"</CHECKSUM>"
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CODE>"
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<![CDATA["
- . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_START")=LC+1
- . S LINE=0
- . F S LINE=$O(^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE)) Q:LINE="" D
- .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)=^TMP(TMPIND,$J,"ROUTINE",RNAME,LINE,0)
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="]]>"
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</CODE>"
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</M_ROUTINE>"
- . S ^TMP($J,"CIND",NCMPNT,"ROUTINE_CODE_END")=LC-3
- ;
- ;Do file entries. For word processing fields the first line is
- ;file number;source ien string;field~WP-start~line count
- ;The next line count lines are the WP data.
- S NUMF=+$G(^TMP(TMPIND,$J,"NUMF"))
- S FILENAME=""
- F IND=1:1:NUMF D
- . F S FILENAME=$O(^TMP(TMPIND,$J,IND,FILENAME)) Q:FILENAME="" D
- .. I FILENAME["IENROOT" S NEWFILE=0,IENROOT=1
- .. E S NEWFILE=1,IENROOT=0
- .. I NEWFILE D
- ... S FILENUM=$O(^TMP(TMPIND,$J,IND,FILENAME,""))
- ... S SIENS=$O(^TMP(TMPIND,$J,IND,FILENAME,FILENUM,""))
- ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILEMAN_FILE>"
- ... S NCMPNT=NCMPNT+1
- ... S ^TMP($J,"CIND",NCMPNT,"FILE_START")=LC
- ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NAME>"_$$TOXML^PXRMEXU3(FILENAME)_"</FILE_NAME>"
- ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<FILE_NUMBER>"_FILENUM_"</FILE_NUMBER>"
- ... S LC=LC+1,PT01=^TMP(TMPIND,$J,IND,FILENAME,FILENUM,SIENS,.01)
- ... S ^TMP("PXRMEXRS",$J,LC,0)="<POINT_01>"_$$TOXML^PXRMEXU3(PT01)_"</POINT_01>"
- ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<INTERNAL_ENTRY_NUMBER>"_+SIENS_"</INTERNAL_ENTRY_NUMBER>"
- ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$J,IND,FILENAME)_"</CHECKSUM>"
- ... S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<SELECTED>"_$S($D(SELLIST(FILENUM,"IEN",+SIENS)):"YES",1:"NO")_"</SELECTED>"
- ... S ^TMP($J,"CIND",NCMPNT,"FDA_START")=LC+3
- ... D FDA(IND,.LC,TMPIND,FILENAME)
- ... S ^TMP($J,"CIND",NCMPNT,"FDA_END")=LC-2
- ..;The ien root information always comes after the FDA.
- .. I IENROOT D
- ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_START")=LC+3
- ... D IENROOT(IND,.LC,TMPIND,FILENAME)
- ... S ^TMP($J,"CIND",NCMPNT,"IEN_ROOT_END")=LC-2
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</FILEMAN_FILE>"
- ;Save the index.
- S LC=LC+1,^TMP("PXRMEXRS",$J,4,0)="<INDEX_AT>"_LC_"</INDEX_AT>"
- S ^TMP("PXRMEXRS",$J,LC,0)="<INDEX>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<NUMBER_OF_COMPONENTS>"_NCMPNT_"</NUMBER_OF_COMPONENTS>"
- F IND=1:1:NCMPNT D
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<COMPONENT>"
- . S JND=""
- . F S JND=$O(^TMP($J,"CIND",IND,JND)) Q:JND="" D
- .. S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="<"_JND_">"_^TMP($J,"CIND",IND,JND)_"</"_JND_">"
- . S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</COMPONENT>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</INDEX>"
- S LC=LC+1,^TMP("PXRMEXRS",$J,LC,0)="</REMINDER_EXCHANGE_FILE_ENTRY>"
- ;Establish the entry in the repository.
- S SOURCE=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
- S DATE=^TMP(TMPIND,$J,"SRC","DATE")
- S FDA(811.8,"+1,",.01)=EFNAME
- S FDA(811.8,"+1,",.02)=SOURCE
- S FDA(811.8,"+1,",.03)=DATE
- D UPDATE^PXRMEXPU(.SUCCESS,.FDA,.IENROOT)
- I SUCCESS D
- . M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXRS",$J)
- .;Set the 0 node.
- . S ^PXD(811.8,IENROOT(1),100,0)=U_811.801_U_LC_U_LC
- .;Create the description for this repository entry.
- . N DESC,DESL,KEYWORD
- . S DESL("SOURCE")=^TMP(TMPIND,$J,"SRC","USER")_" at "_^TMP(TMPIND,$J,"SRC","SITE")
- . S DESL("DATEP")=^TMP(TMPIND,$J,"SRC","DATE")
- . S DESL("VRSN")=VERSN
- . S DESC="^TMP(TMPIND,$J,""DESC"")"
- . S KEYWORD="^TMP(TMPIND,$J,""KEYWORD"")"
- . D DESC^PXRMEXU1(IENROOT(1),.DESL,$NA(@DESC),$NA(@KEYWORD))
- . F IND=1:1:LC D
- .. S LINE=^TMP("PXRMEXRS",$J,IND,0)
- .. I LINE["<FILE_NAME>" S FILENAME=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
- .. I LINE["<POINT_01>" S PT01=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
- .. I LINE["<INTERNAL_ENTRY_NUMBER>" S IEN=$$GETTAGV^PXRMEXU3(LINE,"<INTERNAL_ENTRY_NUMBER>",1)
- ..;Use 1024 to be conservative.
- .. I $L(LINE)<1025 Q
- .. D MLWARN(FILENAME,PT01,IEN,LINE,1024)
- K ^TMP($J,"CIND"),^TMP("PXRMEXRS",$J)
- K ^TMP(TMPIND,$J),^TMP("PXRMEXCS",$J)
- Q
- ;
- ;=================================
- XMLOUT(IEN) ;Write out the XML content of repository entry ien.
- N LC,NLINES
- S NLINES=$O(^PXD(811.8,IEN,100,""),-1)
- F LC=1:1:NLINES W !,^PXD(811.8,IEN,100,LC,0)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXU2 10967 printed Jan 18, 2025@02:46:31 Page 2
- 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
- +2 ;=================================
- EXCLASS(IEN) ;Return the class of the Exchange entry.
- +1 NEW ENV,TEMP
- +2 ;If the Environment has been saved it will be on line 9.
- +3 SET TEMP=^PXD(811.8,IEN,100,9,0)
- +4 SET ENV=$SELECT(TEMP["<ENV>":$$GETTAGV^PXRMEXU3(TEMP,"<ENV>",0),1:"")
- +5 ;If ENV was not found on line 9 search for it.
- +6 IF ENV=""
- Begin DoDot:1
- +7 NEW IND
- +8 SET TEMP=""
- +9 FOR IND=1:1
- if (ENV'="")!(TEMP["</SOURCE>")
- QUIT
- Begin DoDot:2
- +10 SET TEMP=^PXD(811.8,IEN,100,IND,0)
- +11 IF TEMP["<ENV>"
- SET ENV=$$GETTAGV^PXRMEXU3(TEMP,"<ENV>",0)
- End DoDot:2
- End DoDot:1
- +12 QUIT $SELECT($PIECE(ENV,U,1)="NATREM":1,$GET(PXRMINST)=1:1,$DATA(XPDNM):1,1:0)
- +13 ;
- +14 ;=================================
- FDA(IND,LC,TMPIND,FILENAME) ;Build the XML FDA output.
- +1 NEW FIELD,FILENUM,INDEX,INDEX0,JND,SIENS,WPC
- +2 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILEMAN_FDA>"
- +3 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<![CDATA["
- +4 ;Get the file number.
- +5 SET FILENUM=""
- +6 FOR
- SET FILENUM=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM))
- if FILENUM=""
- QUIT
- Begin DoDot:1
- +7 ;Get the source IEN string.
- +8 SET SIENS=""
- +9 FOR
- SET SIENS=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS))
- if SIENS=""
- QUIT
- Begin DoDot:2
- +10 SET INDEX0=FILENUM_";"_SIENS
- +11 ;Get the field number and store the data.
- +12 SET FIELD=""
- +13 FOR
- SET FIELD=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD))
- if FIELD=""
- QUIT
- Begin DoDot:3
- +14 SET INDEX=INDEX0_";"_FIELD
- +15 ;If there is another index past the field then this is a
- +16 ;word-processing field.
- +17 IF $DATA(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD))=11
- Begin DoDot:4
- +18 SET WPC=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD,""),-1)
- +19 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)=INDEX_"~WP-start~"_WPC
- +20 FOR JND=1:1:WPC
- Begin DoDot:5
- +21 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)=^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD,JND)
- End DoDot:5
- End DoDot:4
- +22 IF '$TEST
- SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)=INDEX_"~"_^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,FIELD)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]>"
- +24 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</FILEMAN_FDA>"
- +25 QUIT
- +26 ;
- +27 ;=================================
- IENROOT(IND,LC,TMPIND,FILENAME) ;Build the XML IEN_ROOT output.
- +1 NEW INDEX,VALUE
- +2 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<IEN_ROOT>"
- +3 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<![CDATA["
- +4 SET INDEX=0
- +5 FOR
- SET INDEX=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,INDEX))
- if INDEX=""
- QUIT
- Begin DoDot:1
- +6 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)=INDEX_U_^TMP(TMPIND,$JOB,IND,FILENAME,INDEX)
- End DoDot:1
- +7 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]>"
- +8 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</IEN_ROOT>"
- +9 QUIT
- +10 ;
- +11 ;=================================
- MLWARN(FILENAME,PT01,IEN,LINE,MAXLEN) ;Issue a warning if the length of the
- +1 ;line exceeds the maximum allowed value.
- +2 NEW DATA,INDICES,FIELD,LEN,TEXT
- +3 SET LEN=$LENGTH(LINE)
- +4 SET INDICES=$PIECE(LINE,"~",1)
- +5 SET FIELD=$PIECE(INDICES,";",3)
- +6 SET DATA=$PIECE(LINE,"~",2)
- +7 SET TEXT(1)="Warning the following line exceeds the VistA maximum allowed length of "_MAXLEN_"."
- +8 SET TEXT(2)="Therefore this Exchange entry will not transport correctly."
- +9 SET TEXT(3)="Line: "_LINE
- +10 SET TEXT(4)="Its length is: "_LEN
- +11 SET TEXT(5)="Component: "_FILENAME
- +12 SET TEXT(6)="Name: "_PT01
- +13 SET TEXT(7)="IEN: "_IEN
- +14 SET TEXT(8)="Field number: "_FIELD
- +15 SET TEXT(9)="Value: "_DATA
- +16 SET TEXT(10)=""
- +17 DO EN^DDIOL(.TEXT)
- +18 HANG 2
- +19 QUIT
- +20 ;
- +21 ;=================================
- PATTR(IEN,ATTR) ;If the Reminder Exchange entry has the packing attribute
- +1 ;ATTR return 1 otherwise return 0.
- +2 IF $DATA(^PXD(811.8,IEN,140,"B",ATTR))
- QUIT 1
- +3 QUIT 0
- +4 ;
- +5 ;=================================
- STOREPR(SUCCESS,EFNAME,TMPIND,SELLIST) ;^TMP(TMPIND,$J contains data to be
- +1 ;stored in the repository. Routines will be found in
- +2 ;^TMP(TMPIND,$J,"ROUTINE",ROUTINE NAME,n) where n is the line number.
- +3 ;File entries will be found in ^TMP(TMPIND,$J,N,FILENAME,indexes).
- +4 ;This is output from the GETS^DIQ call. There are NUMF file entries.
- +5 ;Format and store it as XML in the repository.
- +6 NEW DATE,DTEST,FDA,FILENAME,FILENUM,IEN
- +7 NEW IENROOT,IND,JND,LC,LINE,NCMPNT,NEWFILE,NUMF,PT01,RNAME
- +8 NEW SIENS,SOURCE,TEMP,VERSN
- +9 ;If anything went wrong in the packing process then ^TMP(TMPIND,$J
- +10 ;will not exist.
- +11 IF '$DATA(^TMP(TMPIND,$JOB))
- SET SUCCESS=0
- QUIT
- +12 ;
- +13 KILL ^TMP($JOB,"CIND")
- +14 KILL ^TMP("PXRMEXRS",$JOB)
- +15 SET ^TMP("PXRMEXRS",$JOB,1,0)="<?xml version=""1.0"" standalone=""yes""?>"
- +16 SET ^TMP("PXRMEXRS",$JOB,2,0)="<REMINDER_EXCHANGE_FILE_ENTRY>"
- +17 SET VERSN=$PIECE(^PXRM(800,1,"VERSION"),U,1)
- +18 SET ^TMP("PXRMEXRS",$JOB,3,0)="<PACKAGE_VERSION>"_VERSN_"</PACKAGE_VERSION>"
- +19 ;The pointer to the index will be on line 4 so leave room.
- +20 SET LC=4
- +21 ;Save the source information.
- +22 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<SOURCE>"
- +23 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<NAME>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$JOB,"SRC","NAME"))_"</NAME>"
- +24 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<USER>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$JOB,"SRC","USER"))_"</USER>"
- +25 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<SITE>"_$$TOXML^PXRMEXU3(^TMP(TMPIND,$JOB,"SRC","SITE"))_"</SITE>"
- +26 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<ENV>"_^TMP(TMPIND,$JOB,"SRC","ENV")_"</ENV>"
- +27 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<DATE_PACKED>"_^TMP(TMPIND,$JOB,"SRC","DATE")_"</DATE_PACKED>"
- +28 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</SOURCE>"
- +29 ;
- +30 ;Save the description.
- +31 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<DESCRIPTION><![CDATA["
- +32 SET IND=0
- +33 FOR
- SET IND=$ORDER(^TMP(TMPIND,$JOB,"DESC",1,IND))
- if +IND=0
- QUIT
- Begin DoDot:1
- +34 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)=^TMP(TMPIND,$JOB,"DESC",1,IND,0)
- End DoDot:1
- +35 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]></DESCRIPTION>"
- +36 ;
- +37 ;Save the keywords or phrases.
- +38 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<KEYWORDS>"
- +39 SET IND=0
- +40 FOR
- SET IND=$ORDER(^TMP(TMPIND,$JOB,"KEYWORD",1,IND))
- if +IND=0
- QUIT
- Begin DoDot:1
- +41 SET TEMP=^TMP(TMPIND,$JOB,"KEYWORD",1,IND,0)
- +42 IF TEMP[","
- Begin DoDot:2
- +43 FOR JND=1:1:$LENGTH(TEMP,",")
- Begin DoDot:3
- +44 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3($PIECE(TEMP,",",JND))_"</KEYWORD>"
- End DoDot:3
- End DoDot:2
- +45 IF '$TEST
- SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<KEYWORD>"_$$TOXML^PXRMEXU3(TEMP)_"</KEYWORD>"
- End DoDot:1
- +46 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</KEYWORDS>"
- +47 ;
- +48 ;Save the packing attributes.
- +49 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<PACKING ATTRIBUTES><![CDATA["
- +50 SET IND=0
- +51 FOR
- SET IND=$ORDER(^TMP(TMPIND,$JOB,"PATTR",IND))
- if +IND=0
- QUIT
- Begin DoDot:1
- +52 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<ATTRIBUTE>"_^TMP(TMPIND,$JOB,"PATTR",IND)_"</ATTRIBUTE>"
- End DoDot:1
- +53 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]></PACKING ATTRIBUTES>"
- +54 ;
- +55 SET NCMPNT=0
- +56 ;Do routines first.
- +57 SET RNAME=""
- +58 FOR
- SET RNAME=$ORDER(^TMP(TMPIND,$JOB,"ROUTINE",RNAME))
- if RNAME=""
- QUIT
- Begin DoDot:1
- +59 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<M_ROUTINE>"
- +60 SET NCMPNT=NCMPNT+1
- +61 SET ^TMP($JOB,"CIND",NCMPNT,"M_ROUTINE_START")=LC
- +62 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<ROUTINE_NAME>"_RNAME_"</ROUTINE_NAME>"
- +63 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$JOB,"ROUTINE",RNAME)_"</CHECKSUM>"
- +64 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<CODE>"
- +65 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<![CDATA["
- +66 SET ^TMP($JOB,"CIND",NCMPNT,"ROUTINE_CODE_START")=LC+1
- +67 SET LINE=0
- +68 FOR
- SET LINE=$ORDER(^TMP(TMPIND,$JOB,"ROUTINE",RNAME,LINE))
- if LINE=""
- QUIT
- Begin DoDot:2
- +69 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)=^TMP(TMPIND,$JOB,"ROUTINE",RNAME,LINE,0)
- End DoDot:2
- +70 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="]]>"
- +71 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</CODE>"
- +72 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</M_ROUTINE>"
- +73 SET ^TMP($JOB,"CIND",NCMPNT,"ROUTINE_CODE_END")=LC-3
- End DoDot:1
- +74 ;
- +75 ;Do file entries. For word processing fields the first line is
- +76 ;file number;source ien string;field~WP-start~line count
- +77 ;The next line count lines are the WP data.
- +78 SET NUMF=+$GET(^TMP(TMPIND,$JOB,"NUMF"))
- +79 SET FILENAME=""
- +80 FOR IND=1:1:NUMF
- Begin DoDot:1
- +81 FOR
- SET FILENAME=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME))
- if FILENAME=""
- QUIT
- Begin DoDot:2
- +82 IF FILENAME["IENROOT"
- SET NEWFILE=0
- SET IENROOT=1
- +83 IF '$TEST
- SET NEWFILE=1
- SET IENROOT=0
- +84 IF NEWFILE
- Begin DoDot:3
- +85 SET FILENUM=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,""))
- +86 SET SIENS=$ORDER(^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,""))
- +87 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILEMAN_FILE>"
- +88 SET NCMPNT=NCMPNT+1
- +89 SET ^TMP($JOB,"CIND",NCMPNT,"FILE_START")=LC
- +90 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILE_NAME>"_$$TOXML^PXRMEXU3(FILENAME)_"</FILE_NAME>"
- +91 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<FILE_NUMBER>"_FILENUM_"</FILE_NUMBER>"
- +92 SET LC=LC+1
- SET PT01=^TMP(TMPIND,$JOB,IND,FILENAME,FILENUM,SIENS,.01)
- +93 SET ^TMP("PXRMEXRS",$JOB,LC,0)="<POINT_01>"_$$TOXML^PXRMEXU3(PT01)_"</POINT_01>"
- +94 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<INTERNAL_ENTRY_NUMBER>"_+SIENS_"</INTERNAL_ENTRY_NUMBER>"
- +95 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<CHECKSUM>"_^TMP("PXRMEXCS",$JOB,IND,FILENAME)_"</CHECKSUM>"
- +96 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<SELECTED>"_$SELECT($DATA(SELLIST(FILENUM,"IEN",+SIENS)):"YES",1:"NO")_"</SELECTED>"
- +97 SET ^TMP($JOB,"CIND",NCMPNT,"FDA_START")=LC+3
- +98 DO FDA(IND,.LC,TMPIND,FILENAME)
- +99 SET ^TMP($JOB,"CIND",NCMPNT,"FDA_END")=LC-2
- End DoDot:3
- +100 ;The ien root information always comes after the FDA.
- +101 IF IENROOT
- Begin DoDot:3
- +102 SET ^TMP($JOB,"CIND",NCMPNT,"IEN_ROOT_START")=LC+3
- +103 DO IENROOT(IND,.LC,TMPIND,FILENAME)
- +104 SET ^TMP($JOB,"CIND",NCMPNT,"IEN_ROOT_END")=LC-2
- End DoDot:3
- End DoDot:2
- +105 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</FILEMAN_FILE>"
- End DoDot:1
- +106 ;Save the index.
- +107 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,4,0)="<INDEX_AT>"_LC_"</INDEX_AT>"
- +108 SET ^TMP("PXRMEXRS",$JOB,LC,0)="<INDEX>"
- +109 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<NUMBER_OF_COMPONENTS>"_NCMPNT_"</NUMBER_OF_COMPONENTS>"
- +110 FOR IND=1:1:NCMPNT
- Begin DoDot:1
- +111 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<COMPONENT>"
- +112 SET JND=""
- +113 FOR
- SET JND=$ORDER(^TMP($JOB,"CIND",IND,JND))
- if JND=""
- QUIT
- Begin DoDot:2
- +114 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="<"_JND_">"_^TMP($JOB,"CIND",IND,JND)_"</"_JND_">"
- End DoDot:2
- +115 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</COMPONENT>"
- End DoDot:1
- +116 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</INDEX>"
- +117 SET LC=LC+1
- SET ^TMP("PXRMEXRS",$JOB,LC,0)="</REMINDER_EXCHANGE_FILE_ENTRY>"
- +118 ;Establish the entry in the repository.
- +119 SET SOURCE=^TMP(TMPIND,$JOB,"SRC","USER")_" at "_^TMP(TMPIND,$JOB,"SRC","SITE")
- +120 SET DATE=^TMP(TMPIND,$JOB,"SRC","DATE")
- +121 SET FDA(811.8,"+1,",.01)=EFNAME
- +122 SET FDA(811.8,"+1,",.02)=SOURCE
- +123 SET FDA(811.8,"+1,",.03)=DATE
- +124 DO UPDATE^PXRMEXPU(.SUCCESS,.FDA,.IENROOT)
- +125 IF SUCCESS
- Begin DoDot:1
- +126 MERGE ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXRS",$JOB)
- +127 ;Set the 0 node.
- +128 SET ^PXD(811.8,IENROOT(1),100,0)=U_811.801_U_LC_U_LC
- +129 ;Create the description for this repository entry.
- +130 NEW DESC,DESL,KEYWORD
- +131 SET DESL("SOURCE")=^TMP(TMPIND,$JOB,"SRC","USER")_" at "_^TMP(TMPIND,$JOB,"SRC","SITE")
- +132 SET DESL("DATEP")=^TMP(TMPIND,$JOB,"SRC","DATE")
- +133 SET DESL("VRSN")=VERSN
- +134 SET DESC="^TMP(TMPIND,$J,""DESC"")"
- +135 SET KEYWORD="^TMP(TMPIND,$J,""KEYWORD"")"
- +136 DO DESC^PXRMEXU1(IENROOT(1),.DESL,$NAME(@DESC),$NAME(@KEYWORD))
- +137 FOR IND=1:1:LC
- Begin DoDot:2
- +138 SET LINE=^TMP("PXRMEXRS",$JOB,IND,0)
- +139 IF LINE["<FILE_NAME>"
- SET FILENAME=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1)
- +140 IF LINE["<POINT_01>"
- SET PT01=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1)
- +141 IF LINE["<INTERNAL_ENTRY_NUMBER>"
- SET IEN=$$GETTAGV^PXRMEXU3(LINE,"<INTERNAL_ENTRY_NUMBER>",1)
- +142 ;Use 1024 to be conservative.
- +143 IF $LENGTH(LINE)<1025
- QUIT
- +144 DO MLWARN(FILENAME,PT01,IEN,LINE,1024)
- End DoDot:2
- End DoDot:1
- +145 KILL ^TMP($JOB,"CIND"),^TMP("PXRMEXRS",$JOB)
- +146 KILL ^TMP(TMPIND,$JOB),^TMP("PXRMEXCS",$JOB)
- +147 QUIT
- +148 ;
- +149 ;=================================
- XMLOUT(IEN) ;Write out the XML content of repository entry ien.
- +1 NEW LC,NLINES
- +2 SET NLINES=$ORDER(^PXD(811.8,IEN,100,""),-1)
- +3 FOR LC=1:1:NLINES
- WRITE !,^PXD(811.8,IEN,100,LC,0)
- +4 QUIT
- +5 ;