Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXU1.m
r613 r623 1 PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1.;08/16/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ;===================================================== 4 CLIST(IEN) ;Build the list of components for the repository 5 ;entry IEN. EXTYPE is the type of Exchange entry. The default is 6 ;reminder. 7 N COMIND,COMORDR,CSTART,CSUM,END,FILENAME,FILENUM 8 N IND,INDEXAT,JND,LINE,NCMPNT,NCTYPE,NITEMS,NLINES,NUMCMPNT 9 N PT01,START,TEMP,TAG,TYPE,UCOM,VERSN 10 S LINE=^PXD(811.8,IEN,100,1,0) 11 ;Make sure it is XML version 1. 12 I LINE'["<?xml version=""1.0""" D Q 13 . W !,"Exchange file entry not in proper format!" 14 . S IEN=-1 15 . H 2 16 S LINE=^PXD(811.8,IEN,100,2,0) 17 I LINE'="<REMINDER_EXCHANGE_FILE_ENTRY>" D Q 18 . W !,"Not an Exchange File entry!" 19 . S IEN=-1 20 . H 2 21 S LINE=^PXD(811.8,IEN,100,3,0) 22 S VERSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>") 23 S LINE=^PXD(811.8,IEN,100,4,0) 24 S INDEXAT=+$P(LINE,"<INDEX_AT>",2) 25 S LINE=^PXD(811.8,IEN,100,INDEXAT,0) 26 I LINE'="<INDEX>" D Q 27 . W !,"Index missing, cannot continue!" 28 . S IEN=-1 29 . H 2 30 S JND=INDEXAT+1 31 S LINE=^PXD(811.8,IEN,100,JND,0) 32 S NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>") 33 K ^TMP($J,"CMPNT") 34 F IND=1:1:NCMPNT D 35 . K END,START 36 . F S JND=JND+1,LINE=^PXD(811.8,IEN,100,JND,0) Q:LINE="</COMPONENT>" D 37 .. S TAG=$$GETTAG^PXRMEXU3(LINE) 38 .. I TAG["START" S START(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG) 39 .. I TAG["END" S END(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG) 40 . I $D(START("<M_ROUTINE_START>")) D 41 .. S CSTART=START("<M_ROUTINE_START>") 42 .. S ^TMP($J,"CMPNT",IND,"TYPE")="ROUTINE" 43 .. S LINE=^PXD(811.8,IEN,100,CSTART+1,0) 44 .. S ^TMP($J,"CMPNT",IND,"NAME")=$$GETTAGV^PXRMEXU3(LINE,"<ROUTINE_NAME>") 45 .. S ^TMP($J,"CMPNT",IND,"FILENUM")=0 46 ..;Save the actual start and end of the code. 47 .. S ^TMP($J,"CMPNT",IND,"START")=START("<ROUTINE_CODE_START>") 48 .. S ^TMP($J,"CMPNT",IND,"END")=END("<ROUTINE_CODE_END>") 49 . I $D(START("<FILE_START>")) D 50 .. S CSTART=START("<FILE_START>") 51 .. S LINE=^PXD(811.8,IEN,100,CSTART+1,0) 52 .. S (^TMP($J,"CMPNT",IND,"TYPE"),^TMP($J,"CMPNT",IND,"FILENAME"))=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1) 53 .. S LINE=^PXD(811.8,IEN,100,CSTART+2,0) 54 .. S ^TMP($J,"CMPNT",IND,"FILENUM")=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NUMBER>") 55 .. S LINE=^PXD(811.8,IEN,100,CSTART+3,0) 56 .. S (^TMP($J,"CMPNT",IND,"NAME"),^TMP($J,"CMPNT",IND,"POINT_01"))=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1) 57 ..;Save the actual start and end of the FileMan FDA. 58 .. S ^TMP($J,"CMPNT",IND,"FDA_START")=START("<FDA_START>") 59 .. S ^TMP($J,"CMPNT",IND,"FDA_END")=END("<FDA_END>") 60 .. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_START")=$G(START("<IEN_ROOT_START>")) 61 .. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_END")=$G(END("<IEN_ROOT_END>")) 62 ;Build some indexes to order the component list. 63 F IND=1:1:NCMPNT D 64 . S TYPE=^TMP($J,"CMPNT",IND,"TYPE") 65 . S COMIND(TYPE,IND)="" 66 . S UCOM(TYPE)="" 67 ;Build the component order for display and install. 68 D CORDER^PXRMEXCO(IEN,.UCOM,.NUMCMPNT,.COMORDR) 69 ;Set the 0 node. 70 S ^PXD(811.8,IEN,120,0)=U_"811.802A"_U_NCMPNT_U_NCMPNT 71 S NCTYPE=0 72 S NITEMS=0 73 F NCTYPE=1:1:NUMCMPNT D 74 . S TYPE=$O(COMORDR(NCTYPE,"")) 75 . S NITEMS=0 76 . S IND="" 77 . F S IND=$O(COMIND(TYPE,IND)) Q:IND="" D 78 .. S NITEMS=NITEMS+1 79 .. I NITEMS=1 S FILENUM=^TMP($J,"CMPNT",IND,"FILENUM") 80 .. I TYPE="ROUTINE" S TEMP=^TMP($J,"CMPNT",IND,"NAME")_U_^TMP($J,"CMPNT",IND,"START")_U_^TMP($J,"CMPNT",IND,"END") 81 .. E S TEMP=^TMP($J,"CMPNT",IND,"NAME")_U_^TMP($J,"CMPNT",IND,"FDA_START")_U_^TMP($J,"CMPNT",IND,"FDA_END")_U_$G(^TMP($J,"CMPNT",IND,"IEN_ROOT_START"))_U_$G(^TMP($J,"CMPNT",IND,"IEN_ROOT_END")) 82 .. S ^PXD(811.8,IEN,120,NCTYPE,1,NITEMS,0)=TEMP 83 . S ^PXD(811.8,IEN,120,NCTYPE,0)=TYPE_U_FILENUM_U_NITEMS 84 . S ^PXD(811.8,IEN,120,NCTYPE,1,0)=U_"811.8021A"_U_NITEMS_U_NITEMS 85 ; 86 ;Save the number of component types. 87 S ^PXD(811.8,IEN,119)=NCTYPE 88 K ^TMP($J,"CMPNT") 89 Q 90 ; 91 ;===================================================== 92 DELETE(LIST) ;Delete the repository entries in LIST. 93 N DA,DIK 94 S DIK="^PXD(811.8," 95 S DA="" 96 F S DA=$O(LIST(DA)) Q:+DA=0 D ^DIK 97 Q 98 ; 99 ;===================================================== 100 DELHIST(RIEN,IHIEN) ;Delete install history IHIEN in repository entry RIEN. 101 N DA,DIK 102 S DA=IHIEN,DA(1)=RIEN 103 S DIK="^PXD(811.8,"_DA(1)_",130," 104 D ^DIK 105 Q 106 ; 107 ;===================================================== 108 DESC(RIEN,DESL,DESC,KEYWORD) ;Build the description. 109 N JND,LC,NKEYW 110 S LC=1 111 S ^PXD(811.8,RIEN,110,LC,0)="Reminder: "_DESL("RNAME") 112 S LC=LC+1 113 S ^PXD(811.8,RIEN,110,LC,0)="Source: "_DESL("SOURCE") 114 S LC=LC+1 115 S ^PXD(811.8,RIEN,110,LC,0)="Date Packed: "_DESL("DATEP") 116 S LC=LC+1 117 S ^PXD(811.8,RIEN,110,LC,0)="Package Version: "_DESL("VRSN") 118 S LC=LC+1 119 S ^PXD(811.8,RIEN,110,LC,0)="" 120 ;Add the user's description. 121 S LC=LC+1 122 S ^PXD(811.8,RIEN,110,LC,0)="Description:" 123 F JND=1:1:+$P($G(@DESC@(1,0)),U,4) D 124 . S LC=LC+1 125 . S ^PXD(811.8,RIEN,110,LC,0)=@DESC@(1,JND,0) 126 S LC=LC+1 127 S ^PXD(811.8,RIEN,110,LC,0)="" 128 ;Add the keywords. 129 S LC=LC+1 130 S ^PXD(811.8,RIEN,110,LC,0)="Keywords:" 131 S NKEYW=+$P($G(@KEYWORD@(1,0)),U,4) 132 I NKEYW=0 D 133 . S LC=LC+1 134 . S ^PXD(811.8,RIEN,110,LC,0)="No keywords given" 135 F JND=1:1:NKEYW D 136 . S LC=LC+1 137 . S ^PXD(811.8,RIEN,110,LC,0)=@KEYWORD@(1,JND,0) 138 S LC=LC+1 139 S ^PXD(811.8,RIEN,110,LC,0)="" 140 S LC=LC+1 141 S ^PXD(811.8,RIEN,110,LC,0)="Components:" 142 S ^PXD(811.8,RIEN,110,0)=U_811.804_U_LC_U_LC 143 Q 144 ; 145 ;===================================================== 146 RIEN(LIEN) ;Given the list ien return the repository ien. 147 N RIEN 148 S RIEN=$G(^TMP("PXRMEXLR",$J,"SEL",LIEN)) 149 Q RIEN 150 ; 151 ;===================================================== 152 SAVHIST ;Save the installation history in the repository. 153 N ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,NEWNAME 154 N SUB,TEMP,TOTAL,TYPE,USER 155 ;Find the first open spot in the Installation History node. 156 S (IND,JND)=0 157 F S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(IND>JND) 158 S IND=JND 159 S JND=0 160 F SUB="PXRMEXIA","PXRMEXIAD" D 161 . S INDEX=0 162 . F S INDEX=$O(^TMP(SUB,$J,INDEX)) Q:+INDEX=0 D 163 .. S JND=JND+1 164 .. S CMPNT=$O(^TMP(SUB,$J,INDEX,"")) 165 .. S ITEM=$O(^TMP(SUB,$J,INDEX,CMPNT,"")) 166 .. S ACTION=$O(^TMP(SUB,$J,INDEX,CMPNT,ITEM,"")) 167 .. S NEWNAME=$G(^TMP(SUB,$J,INDEX,CMPNT,ITEM,ACTION)) 168 .. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME 169 ..;Set the 0 node. 170 .. S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND 171 ..;Check for finding item changes and save them. 172 .. S FTYPE="" 173 .. I CMPNT["DEFINITION" S FTYPE="DEFF" 174 .. I CMPNT["DIALOG" S FTYPE="DIAF" 175 .. I CMPNT["TERM" S FTYPE="TRMF" 176 .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D 177 ... N FI,FINDING,KND,OFINDING 178 ... S KND=2 179 ... S FI="" 180 ... F S FI=$O(^TMP(SUB,$J,FTYPE,FI)) Q:FI="" D 181 .... S OFINDING=$O(^TMP(SUB,$J,FTYPE,FI,"")) 182 .... S FINDING=^TMP(SUB,$J,FTYPE,FI,OFINDING) 183 .... I OFINDING=FINDING Q 184 .... S KND=KND+1 185 .... S TEMP=$E(OFINDING,1,33) 186 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING 187 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND 188 ... I KND>2 D 189 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" Finding Changes" 190 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New" 191 ..; 192 ..;Check for TIU template replacements and save them. 193 .. I CMPNT["DIALOG" S FTYPE="DIATIU" 194 .. E S FTYPE="" 195 .. I (FTYPE'=""),($D(^TMP(SUB,$J,FTYPE))) D 196 ... N KND,OTIUT,TIUT,TYPE 197 ... S TYPE="" 198 ... S KND=2 199 ... F S TYPE=$O(^TMP(SUB,$J,FTYPE,TYPE)) Q:TYPE="" D 200 .... S OTIUT="" 201 .... F S OTIUT=$O(^TMP(SUB,$J,FTYPE,TYPE,OTIUT)) Q:OTIUT="" D 202 ..... S TIUT=$G(^TMP(SUB,$J,FTYPE,TYPE,OTIUT)) 203 ..... I OTIUT=TIUT Q 204 ..... I '$D(^TMP(SUB,$J,FTYPE,TYPE,OTIUT,ITEM)) Q 205 ..... S KND=KND+1 206 ..... S TEMP=$E(OTIUT,1,33) 207 ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT 208 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND 209 .... I KND>2 D 210 ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" "_TYPE 211 ..... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New" 212 ;If JND is still 0 then there was nothing to save. 213 I JND>0 D 214 .;Save the header information. 215 . S DATE=^TMP("PXRMEXIA",$J,"DT") 216 . S TYPE=^TMP("PXRMEXIA",$J,"TYPE") 217 . S USER=$$GET1^DIQ(200,DUZ,.01,"") 218 . S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER_U_TYPE 219 . S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)="" 220 .;Set the 0 node. 221 . S (KND,TOTAL)=0 222 . F S KND=+$O(^PXD(811.8,PXRMRIEN,130,KND)) Q:KND=0 S TOTAL=TOTAL+1 223 . S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_IND_U_TOTAL 224 K ^TMP("PXRMEXIA",$J) 225 K ^TMP("PXRMEXIAD",$J) 226 Q 227 ; 1 PXRMEXU1 ; SLC/PKR/PJH - Reminder exchange repository utilities, #1. ;09/20/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ;===================================================== 4 CLIST(IEN) ;Build the list of components for the repository 5 ;entry IEN. EXTYPE is the type of Exchange entry. The default is 6 ;reminder. 7 N COMIND,COMORDR,CSTART,CSUM,END,FILENAME,FILENUM 8 N IND,INDEXAT,JND,LINE,NCMPNT,NCTYPE,NITEMS,NLINES,NUMCMPNT 9 N PT01,START,TEMP,TAG,TYPE,UCOM,VERSN 10 S LINE=^PXD(811.8,IEN,100,1,0) 11 ;Make sure it is XML version 1. 12 I LINE'["<?xml version=""1.0""" D Q 13 . W !,"Exchange file entry not in proper format!" 14 . S IEN=-1 15 . H 2 16 S LINE=^PXD(811.8,IEN,100,2,0) 17 I LINE'="<REMINDER_EXCHANGE_FILE_ENTRY>" D Q 18 . W !,"Not an Exchange File entry!" 19 . S IEN=-1 20 . H 2 21 S LINE=^PXD(811.8,IEN,100,3,0) 22 S VERSN=$$GETTAGV^PXRMEXU3(LINE,"<PACKAGE_VERSION>") 23 S LINE=^PXD(811.8,IEN,100,4,0) 24 S INDEXAT=+$P(LINE,"<INDEX_AT>",2) 25 S LINE=^PXD(811.8,IEN,100,INDEXAT,0) 26 I LINE'="<INDEX>" D Q 27 . W !,"Index missing, cannot continue!" 28 . S IEN=-1 29 . H 2 30 S JND=INDEXAT+1 31 S LINE=^PXD(811.8,IEN,100,JND,0) 32 S NCMPNT=+$$GETTAGV^PXRMEXU3(LINE,"<NUMBER_OF_COMPONENTS>") 33 K ^TMP($J,"CMPNT") 34 F IND=1:1:NCMPNT D 35 . K END,START 36 . F S JND=JND+1,LINE=^PXD(811.8,IEN,100,JND,0) Q:LINE="</COMPONENT>" D 37 .. S TAG=$$GETTAG^PXRMEXU3(LINE) 38 .. I TAG["START" S START(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG) 39 .. I TAG["END" S END(TAG)=+$$GETTAGV^PXRMEXU3(LINE,TAG) 40 . I $D(START("<M_ROUTINE_START>")) D 41 .. S CSTART=START("<M_ROUTINE_START>") 42 .. S ^TMP($J,"CMPNT",IND,"TYPE")="ROUTINE" 43 .. S LINE=^PXD(811.8,IEN,100,CSTART+1,0) 44 .. S ^TMP($J,"CMPNT",IND,"NAME")=$$GETTAGV^PXRMEXU3(LINE,"<ROUTINE_NAME>") 45 .. S ^TMP($J,"CMPNT",IND,"FILENUM")=0 46 ..;Save the actual start and end of the code. 47 .. S ^TMP($J,"CMPNT",IND,"START")=START("<ROUTINE_CODE_START>") 48 .. S ^TMP($J,"CMPNT",IND,"END")=END("<ROUTINE_CODE_END>") 49 . I $D(START("<FILE_START>")) D 50 .. S CSTART=START("<FILE_START>") 51 .. S LINE=^PXD(811.8,IEN,100,CSTART+1,0) 52 .. S (^TMP($J,"CMPNT",IND,"TYPE"),^TMP($J,"CMPNT",IND,"FILENAME"))=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NAME>",1) 53 .. S LINE=^PXD(811.8,IEN,100,CSTART+2,0) 54 .. S ^TMP($J,"CMPNT",IND,"FILENUM")=$$GETTAGV^PXRMEXU3(LINE,"<FILE_NUMBER>") 55 .. S LINE=^PXD(811.8,IEN,100,CSTART+3,0) 56 .. S (^TMP($J,"CMPNT",IND,"NAME"),^TMP($J,"CMPNT",IND,"POINT_01"))=$$GETTAGV^PXRMEXU3(LINE,"<POINT_01>",1) 57 ..;Save the actual start and end of the FileMan FDA. 58 .. S ^TMP($J,"CMPNT",IND,"FDA_START")=START("<FDA_START>") 59 .. S ^TMP($J,"CMPNT",IND,"FDA_END")=END("<FDA_END>") 60 .. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_START")=$G(START("<IEN_ROOT_START>")) 61 .. S ^TMP($J,"CMPNT",IND,"IEN_ROOT_END")=$G(END("<IEN_ROOT_END>")) 62 ;Build some indexes to order the component list. 63 F IND=1:1:NCMPNT D 64 . S TYPE=^TMP($J,"CMPNT",IND,"TYPE") 65 . S COMIND(TYPE,IND)="" 66 . S UCOM(TYPE)="" 67 ;Build the component order for display and install. 68 D CORDER^PXRMEXCO(IEN,.UCOM,.NUMCMPNT,.COMORDR) 69 ;Set the 0 node. 70 S ^PXD(811.8,IEN,120,0)=U_"811.802A"_U_NCMPNT_U_NCMPNT 71 S NCTYPE=0 72 S NITEMS=0 73 F NCTYPE=1:1:NUMCMPNT D 74 . S TYPE=$O(COMORDR(NCTYPE,"")) 75 . S NITEMS=0 76 . S IND="" 77 . F S IND=$O(COMIND(TYPE,IND)) Q:IND="" D 78 .. S NITEMS=NITEMS+1 79 .. I NITEMS=1 S FILENUM=^TMP($J,"CMPNT",IND,"FILENUM") 80 .. I TYPE="ROUTINE" S TEMP=^TMP($J,"CMPNT",IND,"NAME")_U_^TMP($J,"CMPNT",IND,"START")_U_^TMP($J,"CMPNT",IND,"END") 81 .. E S TEMP=^TMP($J,"CMPNT",IND,"NAME")_U_^TMP($J,"CMPNT",IND,"FDA_START")_U_^TMP($J,"CMPNT",IND,"FDA_END")_U_$G(^TMP($J,"CMPNT",IND,"IEN_ROOT_START"))_U_$G(^TMP($J,"CMPNT",IND,"IEN_ROOT_END")) 82 .. S ^PXD(811.8,IEN,120,NCTYPE,1,NITEMS,0)=TEMP 83 . S ^PXD(811.8,IEN,120,NCTYPE,0)=TYPE_U_FILENUM_U_NITEMS 84 . S ^PXD(811.8,IEN,120,NCTYPE,1,0)=U_"811.8021A"_U_NITEMS_U_NITEMS 85 ; 86 ;Save the number of component types. 87 S ^PXD(811.8,IEN,119)=NCTYPE 88 K ^TMP($J,"CMPNT") 89 Q 90 ; 91 ;===================================================== 92 DELETE(LIST) ;Delete the repository entries in LIST. 93 N DA,DIK 94 S DIK="^PXD(811.8," 95 S DA="" 96 F S DA=$O(LIST(DA)) Q:+DA=0 D ^DIK 97 Q 98 ; 99 ;===================================================== 100 DELHIST(RIEN,IHIND) ;Delete install history IHIND in repository entry RIEN. 101 N DATE 102 S DATE=$P(^PXD(811.8,RIEN,130,IHIND,0),U) 103 K ^PXD(811.8,RIEN,130,IHIND) 104 K ^PXD(811.8,RIEN,130,"B",DATE) 105 Q 106 ; 107 ;===================================================== 108 DESC(RIEN,DESL,DESC,KEYWORD) ;Build the description. 109 N JND,LC,NKEYW 110 S LC=1 111 S ^PXD(811.8,RIEN,110,LC,0)="Reminder: "_DESL("RNAME") 112 S LC=LC+1 113 S ^PXD(811.8,RIEN,110,LC,0)="Source: "_DESL("SOURCE") 114 S LC=LC+1 115 S ^PXD(811.8,RIEN,110,LC,0)="Date Packed: "_DESL("DATEP") 116 S LC=LC+1 117 S ^PXD(811.8,RIEN,110,LC,0)="Package Version: "_DESL("VRSN") 118 S LC=LC+1 119 S ^PXD(811.8,RIEN,110,LC,0)="" 120 ;Add the user's description. 121 S LC=LC+1 122 S ^PXD(811.8,RIEN,110,LC,0)="Description:" 123 F JND=1:1:+$P($G(@DESC@(1,0)),U,4) D 124 . S LC=LC+1 125 . S ^PXD(811.8,RIEN,110,LC,0)=@DESC@(1,JND,0) 126 S LC=LC+1 127 S ^PXD(811.8,RIEN,110,LC,0)="" 128 ;Add the keywords. 129 S LC=LC+1 130 S ^PXD(811.8,RIEN,110,LC,0)="Keywords:" 131 S NKEYW=+$P($G(@KEYWORD@(1,0)),U,4) 132 I NKEYW=0 D 133 . S LC=LC+1 134 . S ^PXD(811.8,RIEN,110,LC,0)="No keywords given" 135 F JND=1:1:NKEYW D 136 . S LC=LC+1 137 . S ^PXD(811.8,RIEN,110,LC,0)=@KEYWORD@(1,JND,0) 138 S LC=LC+1 139 S ^PXD(811.8,RIEN,110,LC,0)="" 140 S LC=LC+1 141 S ^PXD(811.8,RIEN,110,LC,0)="Components:" 142 S ^PXD(811.8,RIEN,110,0)=U_811.804_U_LC_U_LC 143 Q 144 ; 145 ;===================================================== 146 RIEN(LIEN) ;Given the list ien return the repository ien. 147 N RIEN 148 S RIEN=$G(^TMP("PXRMEXLR",$J,"IDX",LIEN,LIEN)) 149 Q RIEN 150 ; 151 ;===================================================== 152 SAVHIST ;Save the installation history in the repository. 153 N ACTION,DATE,CMPNT,FTYPE,IND,INDEX,ITEM,JND,NEWNAME,TEMP,USER 154 ;Find the first open spot in the Installation History node. 155 S (IND,JND)=0 156 F S IND=+$O(^PXD(811.8,PXRMRIEN,130,IND)) S JND=JND+1 Q:(IND=0)!(JND>IND) 157 ;Set the 0 node. 158 S ^PXD(811.8,PXRMRIEN,130,0)=U_"811.803DA"_U_JND_U_JND 159 S IND=JND 160 S DATE=^TMP("PXRMEXIA",$J,"DT") 161 S USER=$$GET1^DIQ(200,DUZ,.01,"") 162 S ^PXD(811.8,PXRMRIEN,130,IND,0)=DATE_U_USER 163 S ^PXD(811.8,PXRMRIEN,130,"B",DATE,IND)="" 164 S (INDEX,JND)=0 165 F S INDEX=$O(^TMP("PXRMEXIA",$J,INDEX)) Q:+INDEX=0 D 166 . S JND=JND+1 167 . S CMPNT=$O(^TMP("PXRMEXIA",$J,INDEX,"")) 168 . S ITEM=$O(^TMP("PXRMEXIA",$J,INDEX,CMPNT,"")) 169 . S ACTION=$O(^TMP("PXRMEXIA",$J,INDEX,CMPNT,ITEM,"")) 170 . S NEWNAME=$G(^TMP("PXRMEXIA",$J,INDEX,CMPNT,ITEM,ACTION)) 171 . S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,0)=INDEX_U_CMPNT_U_ITEM_U_ACTION_U_NEWNAME 172 .;Set the 0 node. 173 . S ^PXD(811.8,PXRMRIEN,130,IND,1,0)=U_"811.8031A"_U_JND_U_JND 174 .;Check for finding item changes and save them. 175 . S FTYPE="" 176 . I CMPNT["DEFINITION" S FTYPE="DEFF" 177 . I CMPNT["DIALOG" S FTYPE="DIAF" 178 . I CMPNT["TERM" S FTYPE="TRMF" 179 . I (FTYPE'=""),($D(^TMP("PXRMEXIA",$J,FTYPE))) D 180 .. N FI,FINDING,KND,OFINDING 181 .. S KND=2 182 .. S FI="" 183 .. F S FI=$O(^TMP("PXRMEXIA",$J,FTYPE,FI)) Q:FI="" D 184 ... S OFINDING=$O(^TMP("PXRMEXIA",$J,FTYPE,FI,"")) 185 ... S FINDING=^TMP("PXRMEXIA",$J,FTYPE,FI,OFINDING) 186 ... I OFINDING=FINDING Q 187 ... S KND=KND+1 188 ... S TEMP=$E(OFINDING,1,33) 189 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_FINDING 190 .. S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND 191 .. I KND>2 D 192 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" Finding Changes" 193 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New" 194 .; 195 .;Check for TIU template replacements and save them. 196 . I CMPNT["DIALOG" S FTYPE="DIATIU" 197 . E S FTYPE="" 198 . I (FTYPE'=""),($D(^TMP("PXRMEXIA",$J,FTYPE))) D 199 .. N KND,OTIUT,TIUT,TYPE 200 .. S TYPE="" 201 .. S KND=2 202 .. F S TYPE=$O(^TMP("PXRMEXIA",$J,FTYPE,TYPE)) Q:TYPE="" D 203 ... S OTIUT="" 204 ... F S OTIUT=$O(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT)) Q:OTIUT="" D 205 .... S TIUT=$G(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT)) 206 .... I OTIUT=TIUT Q 207 .... I '$D(^TMP("PXRMEXIA",$J,FTYPE,TYPE,OTIUT,ITEM)) Q 208 .... S KND=KND+1 209 .... S TEMP=$E(OTIUT,1,33) 210 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,KND,0)=" "_TEMP_$$INSCHR^PXRMEXLC((35-$L(TEMP))," ")_TIUT 211 ... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,0)=U_"811.80315A"_U_KND_U_KND 212 ... I KND>2 D 213 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,1,0)=" "_TYPE 214 .... S ^PXD(811.8,PXRMRIEN,130,IND,1,JND,1,2,0)=" Original"_$$INSCHR^PXRMEXLC(27," ")_"New" 215 K ^TMP("PXRMEXIA",$J) 216 Q 217 ;
Note:
See TracChangeset
for help on using the changeset viewer.
