Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMUTIL.m

    r613 r623  
    1 PXRMUTIL        ; SLC/PKR/PJH - Utility routines for use by PXRM. ;10/02/2007
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4         ;=================================
    5 ATTVALUE(STRING,ATTR,SEP,AVSEP) ;STRING contains a list of attribute value
    6         ;pairs. Each pair is separated by SEP and the attribute value pair
    7         ;is separated by AVSEP. Return the value for the attribute ATTR.
    8         N AVPAIR,IND,NUMAVP,VALUE
    9         S NUMAVP=$L(STRING,SEP)
    10         S VALUE=""
    11         F IND=1:1:NUMAVP Q:VALUE'=""  D
    12         . S AVPAIR=$P(STRING,SEP,IND)
    13         . I AVPAIR[ATTR S VALUE=$P(AVPAIR,AVSEP,2)
    14         Q VALUE
    15         ;
    16         ;=================================
    17 ACOPY(REF,OUTPUT)       ;Copy all the descendants of the array reference into a linear
    18         ;array. REF is the starting array reference, for example A or
    19         ;^TMP("PXRM",$J). OUTPUT is the linear array for the output. It
    20         ;should be in the form of a closed root, i.e., A() or ^TMP($J,).
    21         ;Note OUTPUT cannot be used as the name of the output array.
    22         N DONE,IND,LEN,NL,OROOT,OUT,PROOT,ROOT,START,TEMP
    23         I REF="" Q
    24         S NL=0
    25         S OROOT=$P(OUTPUT,")",1)
    26         S PROOT=$P(REF,")",1)
    27         ;Build the root so we can tell when we are done.
    28         S TEMP=$NA(@REF)
    29         S ROOT=$P(TEMP,")",1)
    30         S REF=$Q(@REF)
    31         I REF'[ROOT Q
    32         S DONE=0
    33         F  Q:(REF="")!(DONE)  D
    34         . S START=$F(REF,ROOT)
    35         . S LEN=$L(REF)
    36         . S IND=$E(REF,START,LEN)
    37         . S NL=NL+1
    38         . S OUT=OROOT_NL_")"
    39         . S @OUT=PROOT_IND_"="_@REF
    40         . S REF=$Q(@REF)
    41         . I REF'[ROOT S DONE=1
    42         Q
    43         ;
    44         ;=================================
    45 AWRITE(REF)     ;Write all the descendants of the array reference.
    46         ;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
    47         N DONE,IND,LEN,PROOT,ROOT,START,TEMP
    48         I REF="" Q
    49         S PROOT=$P(REF,")",1)
    50         ;Build the root so we can tell when we are done.
    51         S TEMP=$NA(@REF)
    52         S ROOT=$P(TEMP,")",1)
    53         S REF=$Q(@REF)
    54         I REF'[ROOT Q
    55         S DONE=0
    56         F  Q:(REF="")!(DONE)  D
    57         . S START=$F(REF,ROOT)
    58         . S LEN=$L(REF)
    59         . S IND=$E(REF,START,LEN)
    60         . W !,PROOT_IND,"=",@REF
    61         . S REF=$Q(@REF)
    62         . I REF'[ROOT S DONE=1
    63         Q
    64         ;
    65         ;=================================
    66 DIP(VAR,IEN,PXRMROOT,FLDS)      ;Do general inquiry for IEN return formatted
    67         ;output in VAR. VAR can be either a local variable or a global.
    68         ;If it is a local it is indexed for the broker. If it is a global
    69         ;it should be passed in closed form i.e., ^TMP("PXRMTEST",$J).
    70         ;It will be returned formatted for ListMan i.e.,
    71         ;^TMP("PXRMTEST",$J,N,0).
    72         N %ZIS,ARRAY,BY,DC,DHD,DIC,DONE,FF,FILENAME,FILESPEC,FR,GBL,HFNAME
    73         N IND,IOP,L,NOW,PATH,SUCCESS,TO,UNIQN
    74         S BY="NUMBER",(FR,TO)=+$P(IEN,U,1),DHD="@@"
    75         ;Make sure the PXRM WORKSTATION device exists.
    76         D MKWSDEV^PXRMHOST
    77         ;Set up the output file before DIP is called.
    78         S PATH=$$PWD^%ZISH
    79         S NOW=$$NOW^XLFDT
    80         S NOW=$TR(NOW,".","")
    81         S UNIQN=$J_NOW
    82         S FILENAME="PXRMWSD"_UNIQN_".DAT"
    83         S HFNAME=PATH_FILENAME
    84         S IOP="PXRM WORKSTATION;80"
    85         S %ZIS("HFSMODE")="W"
    86         S %ZIS("HFSNAME")=HFNAME
    87         S L=0,DIC=PXRMROOT
    88         D EN1^DIP
    89         ;Move the host file into a global.
    90         S GBL="^TMP(""PXRMUTIL"",$J,1,0)"
    91         S GBL=$NA(@GBL)
    92         K ^TMP("PXRMUTIL",$J)
    93         S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)
    94         ;Look for a form feed, remove it and all subsequent lines.
    95         S FF=$C(12)
    96         I $G(VAR)["^" D
    97         . S VAR=$NA(@VAR)
    98         . S VAR=$P(VAR,")",1)
    99         . S VAR=VAR_",IND,0)"
    100         . S (DONE,IND)=0
    101         . F  Q:DONE  S IND=$O(^TMP("PXRMUTIL",$J,IND)) Q:+IND=0  D
    102         .. I ^TMP("PXRMUTIL",$J,IND,0)=FF S DONE=1 Q
    103         .. S @VAR=^TMP("PXRMUTIL",$J,IND,0)
    104         E  D
    105         . S (DONE,IND)=0
    106         . F  Q:DONE  S IND=$O(^TMP("PXRMUTIL",$J,IND)) Q:+IND=0  D
    107         .. S VAR(IND)=^TMP("PXRMUTIL",$J,IND,0)
    108         .. I VAR(IND)=FF K ARRAY(IND) S DONE=1
    109         K ^TMP("PXRMUTIL",$J)
    110         ;Delete the host file.
    111         S FILESPEC(FILENAME)=""
    112         S SUCCESS=$$DEL^%ZISH(PATH,$NA(FILESPEC))
    113         Q
    114         ;
    115         ;=================================
    116 FNFR(ROOT)      ;Given the root of a file return the file number.
    117         Q +$P(@(ROOT_"0)"),U,2)
    118         ;
    119         ;=================================
    120 NTOAN(NUMBER)   ;Given an integer N return an alphabetic string that can be
    121         ;used for sorting. This will be modulus 26. For example N=0 returns
    122         ;A, N=26 returns BA etc.
    123         N ALPH
    124         S ALPH(0)="A",ALPH(1)="B",ALPH(2)="C",ALPH(3)="D",ALPH(4)="E"
    125         S ALPH(5)="F",ALPH(6)="G",ALPH(7)="H",ALPH(8)="I",ALPH(9)="J"
    126         S ALPH(10)="K",ALPH(11)="L",ALPH(12)="M",ALPH(13)="N",ALPH(14)="O"
    127         S ALPH(15)="P",ALPH(16)="Q",ALPH(17)="R",ALPH(18)="S",ALPH(19)="T"
    128         S ALPH(20)="U",ALPH(21)="V",ALPH(22)="W",ALPH(23)="X",ALPH(24)="Y"
    129         S ALPH(25)="Z"
    130         ;
    131         N ANUM,DIGIT,NUM,P26,PC,PWR
    132         S ANUM="",NUM=NUMBER,PWR=0
    133         S P26(PWR)=1
    134         F PWR=1:1 S P26(PWR)=26*P26(PWR-1) I P26(PWR)>NUMBER Q
    135         S PWR=PWR-1
    136         F PC=PWR:-1:0 D
    137         . S DIGIT=NUM\P26(PC)
    138         . S ANUM=ANUM_ALPH(DIGIT)
    139         . S NUM=NUM-(DIGIT*P26(PC))
    140         Q ANUM
    141         ;
    142         ;=================================
    143 RMEHIST(FILENUM,IEN)    ;Remove the edit history for a reminder file.
    144         I (FILENUM<800)!(FILENUM>811.9)!(FILENUM=811.8) Q
    145         N DA,DIK,GLOBAL,ROOT
    146         S GLOBAL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
    147         ;Edit History is stored in node 110 for all files.
    148         S DA(1)=IEN
    149         S DIK=GLOBAL_IEN_",110,"
    150         S ROOT=GLOBAL_IEN_",110,DA)"
    151         S DA=0
    152         F  S DA=+$O(@ROOT) Q:DA=0  D ^DIK
    153         Q
    154         ;
    155         ;=================================
    156 SEHIST(FILENUM,ROOT,IEN)        ;Set the edit date and edit by and prompt the
    157         ;user for the edit comment.
    158         N DIC,DIR,DWLW,DWPK,ENTRY,FDA,FDAIEN,IENS,IND,MSG,SFN,TARGET,X,Y
    159         K ^TMP("PXRMWP",$J)
    160         D FIELD^DID(FILENUM,"EDIT HISTORY","","SPECIFIER","TARGET")
    161         S SFN=+$G(TARGET("SPECIFIER"))
    162         I SFN=0 Q
    163         S ENTRY=ROOT_IEN_",110)"
    164         S IND=$O(@ENTRY@("B"),-1)
    165         S IND=IND+1
    166         S IENS="+"_IND_","_IEN_","
    167         S FDAIEN(IEN)=IEN
    168         S FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
    169         S FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
    170         ;Prompt the user for edit comments.
    171         S DIC="^TMP(""PXRMWP"",$J,"
    172         S DWLW=72
    173         S DWPK=1
    174         W !,"Input your edit comments."
    175         S DIR(0)="Y"_U_"AO"
    176         S DIR("A")="Edit"
    177         S DIR("B")="NO"
    178         D ^DIR
    179         I Y D
    180         . D EN^DIWE
    181         . K ^TMP("PXRMWP",$J,0)
    182         . I $D(^TMP("PXRMWP",$J)) S FDA(SFN,IENS,2)="^TMP(""PXRMWP"",$J)"
    183         D UPDATE^DIE("E","FDA","FDAIEN","MSG")
    184         I $D(MSG) D AWRITE^PXRMUTIL("MSG")
    185         K ^TMP("PXRMWP",$J)
    186         Q
    187         ;
    188         ;=================================
    189 SFRES(SDIR,NRES,FIEVAL) ;Save the finding result.
    190         I NRES=0 S FIEVAL=0 Q
    191         N DATE,IND,OA,SUB,TF
    192         F IND=1:1:NRES S OA(FIEVAL(IND,"DATE"),FIEVAL(IND),IND)=""
    193         ;If SDIR is positive get the oldest date otherwise get the most
    194         ;recent date.
    195         S DATE=$S(SDIR>0:$O(OA("")),1:$O(OA(""),-1))
    196         ;If there is a true finding on DATE get it.
    197         S TF=$O(OA(DATE,""),-1)
    198         S IND=$O(OA(DATE,TF,""))
    199         S FIEVAL=TF
    200         S SUB=""
    201         F  S SUB=$O(FIEVAL(IND,SUB)) Q:SUB=""  M FIEVAL(SUB)=FIEVAL(IND,SUB)
    202         Q
    203         ;
    204         ;=================================
    205 SSPAR(FIND0,NOCC,BDT,EDT)       ;Set the finding search parameters.
    206         S BDT=$P(FIND0,U,8),EDT=$P(FIND0,U,11),NOCC=$P(FIND0,U,14)
    207         I +NOCC=0 S NOCC=1
    208         ;Convert the dates to FileMan dates.
    209         S BDT=$S(BDT="":0,BDT=0:0,1:$$CTFMD^PXRMDATE(BDT))
    210         I EDT="" S EDT="T"
    211         S EDT=$$CTFMD^PXRMDATE(EDT)
    212         ;If EDT does not contain a time set it to the end of the day.
    213         I EDT'["." S EDT=EDT_".235959"
    214         I $G(PXRMDDOC)'=1 Q
    215         S ^TMP("PXRMDDOC",$J,$P(FIND0,U,1,11))=BDT_U_EDT
    216         Q
    217         ;
    218         ;=================================
    219 STRREP(STRING,TS,RS)    ;Replace every occurrence of the target string (TS)
    220         ;in STRING with the replacement string (RS).
    221         ;Example 9.19 (page 220) in "The Complete Mumps" by John Lewkowicz:
    222         ;  F  Q:STRING'[TS  S STRING=$P(STRING,TS)_RS_$P(STRING,TS,2,999)
    223         ;fails if any portion of the target string is contained in the with
    224         ;string. Therefore a more elaborate version is required.
    225         ;
    226         N IND,NPCS,STR
    227         I STRING'[TS Q STRING
    228         ;Count the number of pieces using the target string as the delimiter.
    229         S NPCS=$L(STRING,TS)
    230         ;Extract the pieces and concatenate RS
    231         S STR=""
    232         F IND=1:1:NPCS-1 S STR=STR_$P(STRING,TS,IND)_RS
    233         S STR=STR_$P(STRING,TS,NPCS)
    234         Q STR
    235         ;
    236         ;=================================
    237 VEDIT(ROOT,IEN) ;This is used as a DIC("S") screen to select which entries
    238         ;a user can edit.
    239         N CLASS,ENTRY,VALID
    240         S ENTRY=ROOT_IEN_")"
    241         S CLASS=$P($G(@ENTRY@(100)),U,1)
    242         I CLASS="N" D
    243         . I ($G(PXRMINST)=1),(DUZ(0)="@") S VALID=1
    244         . E  S VALID=0
    245         E  S VALID=1
    246         Q VALID
    247         ;
     1PXRMUTIL ; SLC/PKR/PJH - Utility routines for use by PXRM. ;05/25/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4 ;===========================================================
     5ATTVALUE(STRING,ATTR,SEP,AVSEP) ;STRING contains a list of attribute value
     6 ;pairs. Each pair is separated by SEP and the attribute value pair
     7 ;is separated by AVSEP. Return the value for the attribute ATTR.
     8 N AVPAIR,IND,NUMAVP,VALUE
     9 S NUMAVP=$L(STRING,SEP)
     10 S VALUE=""
     11 F IND=1:1:NUMAVP Q:VALUE'=""  D
     12 . S AVPAIR=$P(STRING,SEP,IND)
     13 . I AVPAIR[ATTR S VALUE=$P(AVPAIR,AVSEP,2)
     14 Q VALUE
     15 ;
     16 ;===========================================================
     17AWRITE(REF) ;Write all the descendants of the array reference.
     18 ;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
     19 N DONE,IND,LEN,PROOT,ROOT,START,TEMP
     20 I REF="" Q
     21 S PROOT=$P(REF,")",1)
     22 ;Build the root so we can tell when we are done.
     23 S TEMP=$NA(@REF)
     24 S ROOT=$P(TEMP,")",1)
     25 S REF=$Q(@REF)
     26 I REF'[ROOT Q
     27 S DONE=0
     28 F  Q:(REF="")!(DONE)  D
     29 . S START=$F(REF,ROOT)
     30 . S LEN=$L(REF)
     31 . S IND=$E(REF,START,LEN)
     32 . W !,PROOT_IND,"=",@REF
     33 . S REF=$Q(@REF)
     34 . I REF'[ROOT S DONE=1
     35 Q
     36 ;
     37 ;===========================================================
     38DIP(VAR,IEN,PXRMROOT,FLDS) ;Do general inquiry for IEN return formatted
     39 ;output in VAR. VAR can be either a local variable or a global.
     40 ;If it is a local it is indexed for the broker. If it is a global
     41 ;it should be passed in closed form i.e., ^TMP("PXRMTEST",$J).
     42 ;It will be returned formatted for ListMan i.e.,
     43 ;^TMP("PXRMTEST",$J,N,0).
     44 N %ZIS,ARRAY,BY,DC,DHD,DIC,DONE,FF,FILENAME,FILESPEC,FR,GBL,HFNAME
     45 N IND,IOP,L,NOW,PATH,SUCCESS,TO,UNIQN
     46 S BY="NUMBER",(FR,TO)=+$P(IEN,U,1),DHD="@@"
     47 ;Make sure the PXRM WORKSTATION device exists.
     48 D MKWSDEV^PXRMHOST
     49 ;Set up the output file before DIP is called.
     50 S PATH=$$PWD^%ZISH
     51 S NOW=$$NOW^XLFDT
     52 S NOW=$TR(NOW,".","")
     53 S UNIQN=$J_NOW
     54 S FILENAME="PXRMWSD"_UNIQN_".DAT"
     55 S HFNAME=PATH_FILENAME
     56 S IOP="PXRM WORKSTATION;80"
     57 S %ZIS("HFSMODE")="W"
     58 S %ZIS("HFSNAME")=HFNAME
     59 S L=0,DIC=PXRMROOT
     60 D EN1^DIP
     61 ;Move the host file into a global.
     62 S GBL="^TMP(""PXRMUTIL"",$J,1,0)"
     63 S GBL=$NA(@GBL)
     64 K ^TMP("PXRMUTIL",$J)
     65 S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)
     66 ;Look for a form feed, remove it and all subsequent lines.
     67 S FF=$C(12)
     68 I $G(VAR)["^" D
     69 . S VAR=$NA(@VAR)
     70 . S VAR=$P(VAR,")",1)
     71 . S VAR=VAR_",IND,0)"
     72 . S (DONE,IND)=0
     73 . F  Q:DONE  S IND=$O(^TMP("PXRMUTIL",$J,IND)) Q:+IND=0  D
     74 .. I ^TMP("PXRMUTIL",$J,IND,0)=FF S DONE=1 Q
     75 .. S @VAR=^TMP("PXRMUTIL",$J,IND,0)
     76 E  D
     77 . S (DONE,IND)=0
     78 . F  Q:DONE  S IND=$O(^TMP("PXRMUTIL",$J,IND)) Q:+IND=0  D
     79 .. S VAR(IND)=^TMP("PXRMUTIL",$J,IND,0)
     80 .. I VAR(IND)=FF K ARRAY(IND) S DONE=1
     81 K ^TMP("PXRMUTIL",$J)
     82 ;Delete the host file.
     83 S FILESPEC(FILENAME)=""
     84 S SUCCESS=$$DEL^%ZISH(PATH,$NA(FILESPEC))
     85 Q
     86 ;
     87 ;===========================================================
     88FNFR(ROOT) ;Given the root of a file return the file number.
     89 Q +$P(@(ROOT_"0)"),U,2)
     90 ;
     91 ;===========================================================
     92NTOAN(NUMBER) ;Given an integer N return an alphabetic string that can be
     93 ;used for sorting. This will be modulus 26. For example N=0 returns
     94 ;A, N=26 returns BA etc.
     95 N ALPH
     96 S ALPH(0)="A",ALPH(1)="B",ALPH(2)="C",ALPH(3)="D",ALPH(4)="E"
     97 S ALPH(5)="F",ALPH(6)="G",ALPH(7)="H",ALPH(8)="I",ALPH(9)="J"
     98 S ALPH(10)="K",ALPH(11)="L",ALPH(12)="M",ALPH(13)="N",ALPH(14)="O"
     99 S ALPH(15)="P",ALPH(16)="Q",ALPH(17)="R",ALPH(18)="S",ALPH(19)="T"
     100 S ALPH(20)="U",ALPH(21)="V",ALPH(22)="W",ALPH(23)="X",ALPH(24)="Y"
     101 S ALPH(25)="Z"
     102 ;
     103 N ANUM,DIGIT,NUM,P26,PC,PWR
     104 S ANUM="",NUM=NUMBER,PWR=0
     105 S P26(PWR)=1
     106 F PWR=1:1 S P26(PWR)=26*P26(PWR-1) I P26(PWR)>NUMBER Q
     107 S PWR=PWR-1
     108 F PC=PWR:-1:0 D
     109 . S DIGIT=NUM\P26(PC)
     110 . S ANUM=ANUM_ALPH(DIGIT)
     111 . S NUM=NUM-(DIGIT*P26(PC))
     112 Q ANUM
     113 ;
     114 ;===========================================================
     115SEHIST(FILENUM,ROOT,IEN) ;Set the edit date and edit by and prompt the
     116 ;user for the edit comment.
     117 N DIC,DIR,DWLW,DWPK,ENTRY,FDA,FDAIEN,IENS,IND,MSG,SFN,TARGET,X,Y
     118 K ^TMP("PXRMWP",$J)
     119 D FIELD^DID(FILENUM,"EDIT HISTORY","","SPECIFIER","TARGET")
     120 S SFN=+$G(TARGET("SPECIFIER"))
     121 I SFN=0 Q
     122 S ENTRY=ROOT_IEN_",110)"
     123 S IND=$O(@ENTRY@("B"),-1)
     124 S IND=IND+1
     125 S IENS="+"_IND_","_IEN_","
     126 S FDAIEN(IEN)=IEN
     127 S FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
     128 S FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
     129 ;Prompt the user for edit comments.
     130 S DIC="^TMP(""PXRMWP"",$J,"
     131 S DWLW=72
     132 S DWPK=1
     133 W !,"Input your edit comments."
     134 S DIR(0)="Y"_U_"AO"
     135 S DIR("A")="Edit"
     136 S DIR("B")="NO"
     137 D ^DIR
     138 I Y D
     139 . D EN^DIWE
     140 . K ^TMP("PXRMWP",$J,0)
     141 . I $D(^TMP("PXRMWP",$J)) S FDA(SFN,IENS,2)="^TMP(""PXRMWP"",$J)"
     142 D UPDATE^DIE("E","FDA","FDAIEN","MSG")
     143 I $D(MSG) D AWRITE^PXRMUTIL("MSG")
     144 K ^TMP("PXRMWP",$J)
     145 Q
     146 ;
     147 ;===========================================================
     148SFRES(SDIR,NRES,FIEVAL) ;Save the finding result.
     149 I NRES=0 S FIEVAL=0 Q
     150 N DATE,IND,OA,SUB,TF
     151 F IND=1:1:NRES S OA(FIEVAL(IND,"DATE"),FIEVAL(IND),IND)=""
     152 ;If SDIR is positive get the oldest date otherwise get the most
     153 ;recent date.
     154 S DATE=$S(SDIR>0:$O(OA("")),1:$O(OA(""),-1))
     155 ;If there is a true finding on DATE get it.
     156 S TF=$O(OA(DATE,""),-1)
     157 S IND=$O(OA(DATE,TF,""))
     158 S FIEVAL=TF
     159 S SUB=""
     160 F  S SUB=$O(FIEVAL(IND,SUB)) Q:SUB=""  M FIEVAL(SUB)=FIEVAL(IND,SUB)
     161 Q
     162 ;
     163 ;===========================================================
     164SSPAR(FIND0,NOCC,BDT,EDT) ;Set the finding search parameters.
     165 S BDT=$P(FIND0,U,8),EDT=$P(FIND0,U,11),NOCC=$P(FIND0,U,14)
     166 I NOCC="" S NOCC=1
     167 ;Convert the dates to FileMan dates.
     168 S BDT=$S(BDT="":0,BDT=0:0,1:$$CTFMD^PXRMDATE(BDT))
     169 I EDT="" S EDT="T"
     170 S EDT=$$CTFMD^PXRMDATE(EDT)
     171 ;If EDT does not contain a time set it to the end of the day.
     172 I EDT'["." S EDT=EDT_".235959"
     173 Q
     174 ;
     175 ;===========================================================
     176STRREP(STRING,TS,RS) ;Replace every occurrence of the target string (TS)
     177 ;in STRING with the replacement string (RS).
     178 ;Example 9.19 (page 220) in "The Complete Mumps" by John Lewkowicz:
     179 ;  F  Q:STRING'[TS  S STRING=$P(STRING,TS)_RS_$P(STRING,TS,2,999)
     180 ;fails if any portion of the target string is contained in the with
     181 ;string. Therefore a more elaborate version is required.
     182 ;
     183 N IND,NPCS,STR
     184 I STRING'[TS Q STRING
     185 ;Count the number of pieces using the target string as the delimiter.
     186 S NPCS=$L(STRING,TS)
     187 ;Extract the pieces and concatenate RS
     188 S STR=""
     189 F IND=1:1:NPCS-1 S STR=STR_$P(STRING,TS,IND)_RS
     190 S STR=STR_$P(STRING,TS,NPCS)
     191 Q STR
     192 ;
     193 ;===========================================================
     194VEDIT(ROOT,IEN) ;This is used as a DIC("S") screen to select which entries
     195 ;a user can edit.
     196 N CLASS,ENTRY,VALID
     197 S ENTRY=ROOT_IEN_")"
     198 S CLASS=$P($G(@ENTRY@(100)),U,1)
     199 I CLASS="N" D
     200 . I ($G(PXRMINST)=1),(DUZ(0)="@") S VALID=1
     201 . E  S VALID=0
     202 E  S VALID=1
     203 Q VALID
     204 ;
Note: See TracChangeset for help on using the changeset viewer.