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/PXRMCOND.m

    r613 r623  
    1 PXRMCOND        ; SLC/PKR - Routines for evaluating conditions. ;06/01/2007
    2         ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
    3         ;
    4         ;============================================================
    5 CASESEN(X,DA,FILENUM)   ;
    6         ;Called by xref on condition case sensitive field in 811.5 and 811.9.
    7         N COND,GBL
    8         S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
    9         S GBL=GBL_DA(1)_",20,"_DA_",3)"
    10         S COND=$P(@GBL,U,1)
    11         D SICOND(COND,.DA,FILENUM)
    12         Q
    13         ;
    14         ;============================================================
    15 COND(CASESEN,ICOND,VSLIST,VA)   ;Evaluate the condition.
    16         N CONVAL,IND,JND,NSTAR,SUB,TEMP,V,VSTAR
    17         S CONVAL=""
    18         ;If there is no condition return true.
    19         I $L($G(ICOND))=0 Q 1
    20         S NSTAR=0
    21         F IND=1:1 S SUB=$P(VSLIST,";",IND) Q:SUB=""  D
    22         . I SUB["*" S NSTAR=NSTAR+1,VSTAR(NSTAR)=$L(SUB,",")_U_SUB
    23         S V=$G(VA("VALUE"))
    24         I 'CASESEN S V=$$UP^XLFSTR(V)
    25         ;Move all non "*" elements of VA into V.
    26         I VSLIST'="" D MV(VSLIST,CASESEN,.V,.VA)
    27         I NSTAR=0 X ICOND S CONVAL=$T
    28         I NSTAR>0 S CONVAL=$$STARCOND(CASESEN,ICOND,.V,.VA,NSTAR,.VSTAR)
    29         Q CONVAL
    30         ;
    31         ;============================================================
    32 KICOND(X,DA,FILENUM)    ;
    33         ;Do not execute as part of a verify fields.
    34         I $G(DIUTIL)="VERIFY FIELDS" Q
    35         ;Do not execute as part of exchange.
    36         I $G(PXRMEXCH) Q
    37         S FILENUM=$G(FILENUM)
    38         I FILENUM=811.5 K ^PXRMD(811.5,DA(1),20,DA,10),^PXRMD(811.5,DA(1),20,DA,11)
    39         I FILENUM=811.9 K ^PXD(811.9,DA(1),20,DA,10),^PXD(811.9,DA(1),20,DA,11)
    40         Q
    41         ;
    42         ;============================================================
    43 MV(VSLIST,CASESEN,V,VA) ;Move the elements of VA included in VSLIST
    44         ;into V and uppercase if necessary.
    45         N IND,NE,RV,RVA,SUB
    46         S NE=$L(VSLIST,";")-1
    47         F IND=1:1:NE D
    48         . S SUB=$P(VSLIST,";",IND)
    49         . I SUB["*" Q
    50         . S RV="V("_SUB_")",RVA="VA("_SUB_")"
    51         .;If VA(SUB) does not exist skip it.
    52         . I '$D(@RVA) Q
    53         . S @RV=$S('CASESEN:$$UP^XLFSTR(@RVA),1:@RVA)
    54         Q
    55         ;
    56         ;============================================================
    57 RECSUB(IND,V,VA,NSTAR,VSTAR,NM,VM,CASESEN,ICOND,CONVAL) ;Called recursively,
    58         ;first substitutes V array elements with "*" in subscript with a
    59         ;replacement value. Once all have been replaced test condition and
    60         ;quit if true. If not true continue until all combinations have been
    61         ;tested.
    62         N JND,RV,RVA,VSUB,VASUB
    63         F JND=1:1:NM(IND) Q:CONVAL  D
    64         . S VASUB=VM(IND,JND)
    65         . S RVA="VA("_VASUB_")"
    66         . S SUB=$P(VSTAR(IND),U,2)
    67         . S RV="V("_SUB_")"
    68         . S @RV=$S('CASESEN:$$UP^XLFSTR(@RVA),1:@RVA)
    69         . I IND<NSTAR D RECSUB(IND+1,.V,.VA,NSTAR,.VSTAR,.NM,.VM,CASESEN,ICOND,.CONVAL)
    70         . I IND=NSTAR X ICOND S CONVAL=$T
    71         ;If there were no substitutions to make, make sure the condition is
    72         ;evaluated.
    73         I 'CONVAL,IND=NSTAR,NM(IND)=0 X ICOND S CONVAL=$T
    74         Q
    75         ;
    76         ;============================================================
    77 SCPAR(FINDPA,CASESEN,COND,UCIFS,ICOND,VSLIST)   ;Set the Condition parameters.
    78         N CONDS
    79         S CONDS=$G(FINDPA(3))
    80         S COND=$P(CONDS,U,1)
    81         ;Even if there is no condition UCIFS could be used for status search.
    82         S UCIFS=$P(CONDS,U,3)
    83         I COND="" Q
    84         S CASESEN=$P(CONDS,U,2)
    85         I CASESEN="" S CASESEN=1
    86         S ICOND=FINDPA(10),VSLIST=FINDPA(11)
    87         Q
    88         ;
    89         ;============================================================
    90 SICOND(X,DA,FILENUM)    ;Set the internal condition field. Wrap all V() in $G.
    91         ;Called by xref on condition field in 811.5 and 811.9.
    92         I X="" Q
    93         ;Do not execute as part of a verify fields.
    94         I $G(DIUTIL)="VERIFY FIELDS" Q
    95         ;Do not execute as part of exchange.
    96         I $G(PXRMEXCH) Q
    97         N CASESEN,GBL,ICOND,IND,SE,SS,SUB,SUBLIST,TEMP,VSLIST,VWSUB,XUP
    98         S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
    99         S GBL=GBL_DA(1)_",20,"_DA_",3)"
    100         S CASESEN=$P(@GBL,U,2)
    101         I CASESEN="" S CASESEN=1
    102         ;Find each V("sub") entry.
    103         S XUP=$$UP^XLFSTR(X)
    104         I 'CASESEN S (ICOND,X)=XUP
    105         I CASESEN S ICOND=$$STRREP^PXRMUTIL(X,"v(","V(")
    106         S SS=1,VSLIST=""
    107         F  S SS=$F(XUP,"V(",SS) Q:SS=0  D
    108         . S SE=$F(X,")",SS)
    109         . S SUB=$E(X,SS,SE-2)
    110         . I $D(SUBLIST(SUB)) Q
    111         . S SUBLIST(SUB)=""
    112         . S VSLIST=VSLIST_SUB_";"
    113         . S VWSUB="V("_SUB_")"
    114         . S TEMP="$G("_VWSUB_")"
    115         . S ICOND=$$STRREP^PXRMUTIL(ICOND,VWSUB,TEMP)
    116         I FILENUM=811.5 S ^PXRMD(811.5,DA(1),20,DA,10)=ICOND,^PXRMD(811.5,DA(1),20,DA,11)=VSLIST
    117         I FILENUM=811.9 S ^PXD(811.9,DA(1),20,DA,10)=ICOND,^PXD(811.9,DA(1),20,DA,11)=VSLIST
    118         Q
    119         ;
    120         ;============================================================
    121 STARCOND(CASESEN,ICOND,V,VA,NSTAR,VSTAR)        ;Execute a star condition,
    122         ;look for any replacements for the * subscripts that will make the
    123         ;Condition true.
    124         N CONVAL,IND,JND,KND,MATCH,NEWV,NM,NVA,ORV,REF,SUB,SUBL,TCOND,TEMP
    125         N VASUB,VSSUB,VM
    126         ;Build a list of the subscripts in VA.
    127         S NVA=0,REF="VA"
    128         F  S REF=$Q(@REF) Q:REF=""  D
    129         . S SUB=$P(REF,"(",2)
    130         . S SUB=$P(SUB,")",1)
    131         . S SUBL=$L(SUB,",")
    132         . S NVA=NVA+1,VASUB(NVA)=SUBL_U_SUB
    133         ;Build a list of replacements for the * subscripts.
    134         F IND=1:1:NSTAR D
    135         . S NM=0
    136         . S VSSUB=$P(VSTAR(IND),U,2)
    137         . S SUBL=+VSTAR(IND)
    138         . F JND=1:1:NVA D
    139         .. I +VASUB(JND)'=SUBL Q
    140         .. S SUB=$P(VASUB(JND),U,2)
    141         .. S MATCH=1
    142         .. F KND=1:1:SUBL D
    143         ... S TEMP=$P(VSSUB,",",KND)
    144         ... I TEMP["*" Q
    145         ... I $P(SUB,",",KND)'=TEMP S MATCH=0,KND=SUBL
    146         .. I MATCH S NM=NM+1,VM(IND,NM)=SUB
    147         . S NM(IND)=NM
    148         S CONVAL=0
    149         F IND=1:1:NSTAR Q:CONVAL  D RECSUB(IND,.V,.VA,NSTAR,.VSTAR,.NM,.VM,CASESEN,ICOND,.CONVAL)
    150         Q CONVAL
    151         ;
    152         ;============================================================
    153 VCOND(X)        ;
    154         ;Input transform on Condition field.
    155         ;Do not execute as part of exchange.
    156         I $G(PXRMEXCH) Q 1
    157         ;The CONDITION must start with "I ".
    158         S X=$$UP^XLFSTR(X)
    159         I $E(X,1,2)'="I " D  Q 0
    160         . S X=""
    161         . D EN^DDIOL("CONDITION must start with ""I"" followed by a single space")
    162         ;The CONDITION cannot contain "^".
    163         I X["^" D  Q 0
    164         . S X=""
    165         . D EN^DDIOL("CONDITION cannot contain ""^""")
    166         ;The CONDITION cannot contain "@".
    167         I X["@" D  Q 0
    168         . S X=""
    169         . D EN^DDIOL("CONDITION cannot contain ""@""")
    170         ;The rest of the condition can only contain spaces if they are in
    171         ;a string.
    172         N COND,TEMP,VALID
    173         S COND=$E(X,3,$L(X))
    174         S VALID=$S(COND[" ":$$VSPACE(COND),1:1)
    175         I VALID S VALID=$S(COND["V(":$$VSUB(COND),1:1)
    176         I VALID D
    177         . D ^DIM
    178         . I '$D(X) D
    179         .. D EN^DDIOL("Not a valid MUMPS string")
    180         .. S VALID=0
    181         Q VALID
    182         ;
    183         ;============================================================
    184 VSPACE(COND)    ;Make sure all spaces in the condition that come after
    185         ;the beginning I are inside a quoted string.
    186         N CHAR,IND,IQ,JND,LQ,NIQ,NQP,NSP,QP,SP,SPACE,VALID
    187         S VALID=1
    188         S (LQ,NQP,NSP)=0
    189         F IND=1:1:$L(COND) D
    190         . S CHAR=$E(COND,IND)
    191         . I CHAR="""" D
    192         .. I LQ S NQP=NQP+1,QP(NQP)=LQ_U_IND,LQ=0
    193         .. E  S LQ=IND
    194         . I CHAR=" " S NSP=NSP+1,SP(NSP)=IND
    195         S NIQ=0
    196         F IND=1:1:NSP D
    197         . S SPACE=SP(NSP)
    198         . S IQ=0
    199         . F JND=1:1:NQP D
    200         .. I SPACE>$P(QP(JND),U,1),SPACE<$P(QP(JND),U,2) S IQ=1,JND=NQP Q
    201         . S NIQ=$S(IQ:0,1:1)
    202         . I NIQ S IND=NSP Q
    203         I NIQ D
    204         . D EN^DDIOL("No spaces are allowed except in quoted strings!")
    205         . S VALID=0
    206         Q VALID
    207         ;
    208         ;============================================================
    209 VSUB(COND)      ;Make sure all V subscripts are quoted strings, numbers
    210         ;or quoted * strings.
    211         N IND,RP,SS,SUB,SUBL,VALID
    212         S (SS,VALID)=1
    213         F  S SS=$F(COND,"V(",SS) Q:('VALID)!(SS=0)  D
    214         . S RP=$F(COND,")",SS)-2
    215         . I RP=-2 D  Q
    216         .. N TEXT
    217         .. S TEXT=$E(COND,SS-2,$L(COND))_" is missing a "")"""
    218         .. D EN^DDIOL(TEXT)
    219         .. S VALID=0
    220         . S SUBL=$E(COND,SS,RP)
    221         . F IND=1:1:$L(SUBL,",") D
    222         .. S SUB=$P(SUBL,",",IND)
    223         ..;Check for a number.
    224         .. I SUB=+SUB Q
    225         ..;Check for a wildcard, must be in quotes any number of * allowed.
    226         .. I SUB?1"""1"*"."*"""" Q
    227         .. ;Check for first and last character = to a ".
    228         .. I ($E(SUB,1)'="""")!($E(SUB,$L(SUB))'="""") S VALID=0
    229         I 'VALID D EN^DDIOL("All V subscripts must be quoted strings, numbers or *!")
    230         Q VALID
    231         ;
     1PXRMCOND ; SLC/PKR - Routines for evaluating conditions. ;11/01/2004
     2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
     3 ;
     4 ;============================================================
     5CASESEN(X,DA,FILENUM) ;
     6 ;Called by xref on condition case sensitive field in 811.5 and 811.9.
     7 N COND,GBL
     8 S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
     9 S GBL=GBL_DA(1)_",20,"_DA_",3)"
     10 S COND=$P(@GBL,U,1)
     11 D SICOND(COND,.DA,FILENUM)
     12 Q
     13 ;
     14 ;============================================================
     15COND(CASESEN,ICOND,VSLIST,VA) ;Evaluate the condition.
     16 N CONVAL,IND,JND,NSTAR,SUB,TEMP,V,VSTAR
     17 S CONVAL=""
     18 ;If there is no condition return true.
     19 I $L($G(ICOND))=0 Q 1
     20 S NSTAR=0
     21 F IND=1:1 S SUB=$P(VSLIST,";",IND) Q:SUB=""  D
     22 . I SUB["*" S NSTAR=NSTAR+1,VSTAR(NSTAR)=$L(SUB,",")_U_SUB
     23 S V=$G(VA("VALUE"))
     24 I 'CASESEN S V=$$UP^XLFSTR(V)
     25 ;Move all non "*" elements of VA into V.
     26 I VSLIST'="" D MV(VSLIST,CASESEN,.V,.VA)
     27 I NSTAR=0 X ICOND S CONVAL=$T
     28 I NSTAR>0 S CONVAL=$$STARCOND(CASESEN,ICOND,.V,.VA,NSTAR,.VSTAR)
     29 Q CONVAL
     30 ;
     31 ;============================================================
     32KICOND(X,DA,FILENUM) ;
     33 ;Do not execute as part of a verify fields.
     34 I $G(DIUTIL)="VERIFY FIELDS" Q
     35 ;Do not execute as part of exchange.
     36 I $G(PXRMEXCH) Q
     37 S FILENUM=$G(FILENUM)
     38 I FILENUM=811.5 K ^PXRMD(811.5,DA(1),20,DA,10),^PXRMD(811.5,DA(1),20,DA,11)
     39 I FILENUM=811.9 K ^PXD(811.9,DA(1),20,DA,10),^PXD(811.9,DA(1),20,DA,11)
     40 Q
     41 ;
     42 ;============================================================
     43MV(VSLIST,CASESEN,V,VA) ;Move the elements of VA included in VSLIST
     44 ;into V and uppercase if necessary.
     45 N IND,NE,RV,RVA,SUB
     46 S NE=$L(VSLIST,";")-1
     47 F IND=1:1:NE D
     48 . S SUB=$P(VSLIST,";",IND)
     49 . I SUB["*" Q
     50 . S RV="V("_SUB_")",RVA="VA("_SUB_")"
     51 .;If VA(SUB) does not exist skip it.
     52 . I '$D(@RVA) Q
     53 . S @RV=$S('CASESEN:$$UP^XLFSTR(@RVA),1:@RVA)
     54 Q
     55 ;
     56 ;============================================================
     57RECSUB(IND,V,VA,NSTAR,VSTAR,NM,VM,CASESEN,ICOND,CONVAL) ;Called recursively,
     58 ;first substitutes V array elements with "*" in subscript with a
     59 ;replacement value. Once all have been replaced test condition and
     60 ;quit if true. If not true continue until all combinations have been
     61 ;tested.
     62 N JND,RV,RVA,VSUB,VASUB
     63 F JND=1:1:NM(IND) Q:CONVAL  D
     64 . S VASUB=VM(IND,JND)
     65 . S RVA="VA("_VASUB_")"
     66 . S SUB=$P(VSTAR(IND),U,2)
     67 . S RV="V("_SUB_")"
     68 . S @RV=$S('CASESEN:$$UP^XLFSTR(@RVA),1:@RVA)
     69 . I IND<NSTAR D RECSUB(IND+1,.V,.VA,NSTAR,.VSTAR,.NM,.VM,CASESEN,ICOND,.CONVAL)
     70 . I IND=NSTAR X ICOND S CONVAL=$T
     71 ;If there were no substitutions to make, make sure the condition is
     72 ;evaluated.
     73 I 'CONVAL,IND=NSTAR,NM(IND)=0 X ICOND S CONVAL=$T
     74 Q
     75 ;
     76 ;============================================================
     77SCPAR(FINDPA,CASESEN,COND,UCIFS,ICOND,VSLIST) ;Set the Condition parameters.
     78 N CONDS
     79 S CONDS=$G(FINDPA(3))
     80 S COND=$P(CONDS,U,1)
     81 S UCIFS=$S(COND="":0,1:$P(CONDS,U,3))
     82 I COND="" Q
     83 S CASESEN=$P(CONDS,U,2)
     84 I CASESEN="" S CASESEN=1
     85 S ICOND=FINDPA(10),VSLIST=FINDPA(11)
     86 Q
     87 ;
     88 ;============================================================
     89SICOND(X,DA,FILENUM) ;Set the internal condition field. Wrap all V() in $G.
     90 ;Called by xref on condition field in 811.5 and 811.9.
     91 I X="" Q
     92 ;Do not execute as part of a verify fields.
     93 I $G(DIUTIL)="VERIFY FIELDS" Q
     94 ;Do not execute as part of exchange.
     95 I $G(PXRMEXCH) Q
     96 N CASESEN,GBL,ICOND,IND,SE,SS,SUB,SUBLIST,TEMP,VSLIST,VWSUB,XUP
     97 S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
     98 S GBL=GBL_DA(1)_",20,"_DA_",3)"
     99 S CASESEN=$P(@GBL,U,2)
     100 I CASESEN="" S CASESEN=1
     101 ;Find each V("sub") entry.
     102 S XUP=$$UP^XLFSTR(X)
     103 I 'CASESEN S (ICOND,X)=XUP
     104 I CASESEN S ICOND=$$STRREP^PXRMUTIL(X,"v(","V(")
     105 S SS=1,VSLIST=""
     106 F  S SS=$F(XUP,"V(",SS) Q:SS=0  D
     107 . S SE=$F(X,")",SS)
     108 . S SUB=$E(X,SS,SE-2)
     109 . I $D(SUBLIST(SUB)) Q
     110 . S SUBLIST(SUB)=""
     111 . S VSLIST=VSLIST_SUB_";"
     112 . S VWSUB="V("_SUB_")"
     113 . S TEMP="$G("_VWSUB_")"
     114 . S ICOND=$$STRREP^PXRMUTIL(ICOND,VWSUB,TEMP)
     115 I FILENUM=811.5 S ^PXRMD(811.5,DA(1),20,DA,10)=ICOND,^PXRMD(811.5,DA(1),20,DA,11)=VSLIST
     116 I FILENUM=811.9 S ^PXD(811.9,DA(1),20,DA,10)=ICOND,^PXD(811.9,DA(1),20,DA,11)=VSLIST
     117 Q
     118 ;
     119 ;============================================================
     120STARCOND(CASESEN,ICOND,V,VA,NSTAR,VSTAR) ;Execute a star condition,
     121 ;look for any replacements for the * subscripts that will make the
     122 ;Condition true.
     123 N CONVAL,IND,JND,KND,MATCH,NEWV,NM,NVA,ORV,REF,SUB,SUBL,TCOND,TEMP
     124 N VASUB,VSSUB,VM
     125 ;Build a list of the subscripts in VA.
     126 S NVA=0,REF="VA"
     127 F  S REF=$Q(@REF) Q:REF=""  D
     128 . S SUB=$P(REF,"(",2)
     129 . S SUB=$P(SUB,")",1)
     130 . S SUBL=$L(SUB,",")
     131 . S NVA=NVA+1,VASUB(NVA)=SUBL_U_SUB
     132 ;Build a list of replacements for the * subscripts.
     133 F IND=1:1:NSTAR D
     134 . S NM=0
     135 . S VSSUB=$P(VSTAR(IND),U,2)
     136 . S SUBL=+VSTAR(IND)
     137 . F JND=1:1:NVA D
     138 .. I +VASUB(JND)'=SUBL Q
     139 .. S SUB=$P(VASUB(JND),U,2)
     140 .. S MATCH=1
     141 .. F KND=1:1:SUBL D
     142 ... S TEMP=$P(VSSUB,",",KND)
     143 ... I TEMP["*" Q
     144 ... I $P(SUB,",",KND)'=TEMP S MATCH=0,KND=SUBL
     145 .. I MATCH S NM=NM+1,VM(IND,NM)=SUB
     146 . S NM(IND)=NM
     147 S CONVAL=0
     148 F IND=1:1:NSTAR Q:CONVAL  D RECSUB(IND,.V,.VA,NSTAR,.VSTAR,.NM,.VM,CASESEN,ICOND,.CONVAL)
     149 Q CONVAL
     150 ;
     151 ;============================================================
     152VCOND(X) ;
     153 ;Input transform on Condition field.
     154 ;Do not execute as part of exchange.
     155 I $G(PXRMEXCH) Q 1
     156 ;The CONDITION must start with "I ".
     157 S X=$$UP^XLFSTR(X)
     158 I $E(X,1,2)'="I " D  Q 0
     159 . S X=""
     160 . D EN^DDIOL("CONDITION must start with ""I"" followed by a single space")
     161 ;The CONDITION cannot contain "^".
     162 I X["^" D  Q 0
     163 . S X=""
     164 . D EN^DDIOL("CONDITION cannot contain ""^""")
     165 ;The CONDITION cannot contain "@".
     166 I X["@" D  Q 0
     167 . S X=""
     168 . D EN^DDIOL("CONDITION cannot contain ""@""")
     169 ;The rest of the condition can only contain spaces if they are in
     170 ;a string.
     171 N COND,TEMP,VALID
     172 S COND=$E(X,3,$L(X))
     173 S VALID=$S(COND[" ":$$VSPACE(COND),1:1)
     174 I VALID S VALID=$S(COND["V(":$$VSUB(COND),1:1)
     175 I VALID D
     176 . D ^DIM
     177 . I '$D(X) D
     178 .. D EN^DDIOL("Not a valid MUMPS string")
     179 .. S VALID=0
     180 Q VALID
     181 ;
     182 ;============================================================
     183VSPACE(COND) ;Make sure all spaces in the condition that come after
     184 ;the beginning I are inside a quoted string.
     185 N CHAR,IND,IQ,JND,LQ,NIQ,NQP,NSP,QP,SP,SPACE,VALID
     186 S VALID=1
     187 S (LQ,NQP,NSP)=0
     188 F IND=1:1:$L(COND) D
     189 . S CHAR=$E(COND,IND)
     190 . I CHAR="""" D
     191 .. I LQ S NQP=NQP+1,QP(NQP)=LQ_U_IND,LQ=0
     192 .. E  S LQ=IND
     193 . I CHAR=" " S NSP=NSP+1,SP(NSP)=IND
     194 S NIQ=0
     195 F IND=1:1:NSP D
     196 . S SPACE=SP(NSP)
     197 . S IQ=0
     198 . F JND=1:1:NQP D
     199 .. I SPACE>$P(QP(JND),U,1),SPACE<$P(QP(JND),U,2) S IQ=1,JND=NQP Q
     200 . S NIQ=$S(IQ:0,1:1)
     201 . I NIQ S IND=NSP Q
     202 I NIQ D
     203 . D EN^DDIOL("No spaces are allowed except in quoted strings!")
     204 . S VALID=0
     205 Q VALID
     206 ;
     207 ;============================================================
     208VSUB(COND) ;Make sure all V subscripts are quoted strings, numbers
     209 ;or quoted * strings.
     210 N IND,RP,SS,SUB,SUBL,VALID
     211 S (SS,VALID)=1
     212 F  S SS=$F(COND,"V(",SS) Q:('VALID)!(SS=0)  D
     213 . S RP=$F(COND,")",SS)-2
     214 . I RP=-2 D  Q
     215 .. N TEXT
     216 .. S TEXT=$E(COND,SS-2,$L(COND))_" is missing a "")"""
     217 .. D EN^DDIOL(TEXT)
     218 .. S VALID=0
     219 . S SUBL=$E(COND,SS,RP)
     220 . F IND=1:1:$L(SUBL,",") D
     221 .. S SUB=$P(SUBL,",",IND)
     222 ..;Check for a number.
     223 .. I SUB=+SUB Q
     224 ..;Check for a wildcard, must be in quotes any number of * allowed.
     225 .. I SUB?1"""1"*"."*"""" Q
     226 .. ;Check for first and last character = to a ".
     227 .. I ($E(SUB,1)'="""")!($E(SUB,$L(SUB))'="""") S VALID=0
     228 I 'VALID D EN^DDIOL("All V subscripts must be quoted strings, numbers or *!")
     229 Q VALID
     230 ;
Note: See TracChangeset for help on using the changeset viewer.