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

    r613 r623  
    1 PXRMFFDB        ;SLC/PKR - Function finding data structure builder. ;10/31/2007
    2         ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
    3         ;
    4         ;===========================================
    5 BASE2(NUM)      ;Convert a base 10 integer to base 2.
    6         N BD,BIN
    7         S BIN=""
    8         F  Q:NUM=0  D
    9         . S BD=$S((NUM\2)=(NUM/2):0,1:1)
    10         . S BIN=BD_BIN,NUM=NUM\2
    11         Q BIN
    12         ;
    13         ;===========================================
    14 CRESLOG(NUM,FLIST,RESLOG)       ;Check the resolution logic to see if
    15         ;it can be made true solely by function findings. If that is the case
    16         ;warn the user. Called by BLDRESLS^PXRMLOGX
    17         N AGEFI,BP,FI,FF,FFL,IND,JND,KND,LE,LEN,LND,NFF,NTC,SEXFI,TEMP,VALUE
    18         S (AGEFI,SEXFI)=0
    19         S NFF=0
    20         F IND=1:1:NUM D
    21         . S JND=$P(FLIST,";",IND)
    22         . I +JND=JND S FI(JND)=0 Q
    23         . I JND["FF" S NFF=NFF+1,FF=$P(JND,"FF",2),FFL(NFF)=FF
    24         I NFF=0 Q
    25         ;Generate and test all combinations of true and false FFs.
    26         S VALUE=0
    27         S NTC=$$PWR^XLFMTH(2,NFF)-1
    28         F IND=1:1:NTC Q:VALUE  D
    29         . S BIN=$$BASE2(IND)
    30         . S LEN=$L(BIN)
    31         . S LE=NFF-LEN
    32         .;Fill in the values for the implied preceeding 0s.
    33         . F JND=1:1:LE S KND=FFL(JND),FF(KND)=0
    34         . S LND=0
    35         . F JND=LE+1:1:NFF D
    36         .. S KND=FFL(JND),LND=LND+1
    37         .. S FF(KND)=$E(BIN,LND)
    38         . I @RESLOG
    39         . S VALUE=$T
    40         I VALUE D
    41         . N RESLSTR
    42         . S RESLSTR=RESLOG
    43         . F IND=1:1:NUM D
    44         .. S JND=$P(FLIST,";",IND)
    45         .. S TEMP=$S(JND["FF":"FF("_$P(JND,"FF",2)_")",1:"FI("_JND_")")
    46         .. S RESLOG=$$STRREP^PXRMUTIL(RESLOG,TEMP,@TEMP)
    47         . S RESLOG=$$STRREP^PXRMUTIL(RESLOG,"AGE",AGEFI)
    48         . S RESLOG=$$STRREP^PXRMUTIL(RESLOG,"SEX",SEXFI)
    49         . W !!,"Warning - your resolution logic can be satisfied by function findings only."
    50         . W !,"If this happens it will not be possible to calculate a resolution date and"
    51         . W !,"the reminder will not be resolved. Here is a case where the logic evaluates"
    52         . W !,"to true:"
    53         . W !,RESLSTR
    54         . W !,RESLOG
    55         . W !
    56         Q
    57         ;
    58         ;=============================================================
    59 FFBUILD(X,DA)   ;Given a function finding logical string build the data
    60         ;structure. This is called by a new-style cross-reference after
    61         ;the function string has passed the input transform so we don't need
    62         ;to validate the elements.
    63         ;Do not execute as part of a verify fields.
    64         I $G(DIUTIL)="VERIFY FIELDS" Q
    65         ;Do not execute as part of exchange.
    66         I $G(PXRMEXCH) Q
    67         N FDA,FUNNUM,FUNP,IENB,IENS,IND,JND,L2,L3,LEN,LIST,LOGIC,OPER,MSG
    68         N PFSTACK,REPL,RS,TEMP,TS,XS
    69         S IENB=DA_","_DA(1)_","
    70         S OPER="!&-+<>='"
    71         S XS=$$PSPACE(X)
    72         D POSTFIX^PXRMSTAC(XS,OPER,.PFSTACK)
    73         S (FUNNUM,L2)=0
    74         F IND=1:1:PFSTACK(0) D
    75         . S TEMP=PFSTACK(IND)
    76         . I $D(^PXRMD(802.4,"B",TEMP)) D
    77         .. S FUNP=$O(^PXRMD(802.4,"B",TEMP,""))
    78         .. S FUNNUM=FUNNUM+1,L2=L2+1
    79         .. S IENS="+"_L2_","_IENB
    80         .. S FDA(811.9255,IENS,.01)=FUNNUM
    81         .. S FDA(811.9255,IENS,.02)=FUNP
    82         .. S IND=IND+1
    83         .. S LIST=$TR(PFSTACK(IND),"~"," ")
    84         .. S REPL(FUNNUM)=TEMP_"("_LIST_")"_U_"FN("_FUNNUM_")"
    85         .. S L3=L2
    86         .. S LEN=$L(LIST,",")
    87         .. F JND=1:1:LEN D
    88         ... S L3=L3+1
    89         ... S IENS="+"_L3_",+"_L2_","_IENB
    90         ... S TS=$P(LIST,",",JND)
    91         ... S TS=$TR(TS,"""","")
    92         ... S FDA(811.9256,IENS,.01)=TS
    93         .. S L2=L3
    94         ;Build the logic string
    95         S LOGIC=X
    96         F IND=1:1:FUNNUM D
    97         . S TS=$P(REPL(IND),U,1)
    98         . S RS=$P(REPL(IND),U,2)
    99         . S LOGIC=$$STRREP^PXRMUTIL(LOGIC,TS,RS)
    100         S FDA(811.925,IENB,10)=LOGIC
    101         D UPDATE^DIE("","FDA","IENB","MSG")
    102         I $D(MSG) D
    103         . W !,"The update failed, UPDATE^DIE returned the following error message:"
    104         . D AWRITE^PXRMUTIL("MSG")
    105         Q
    106         ;
    107         ;=============================================================
    108 FFKILL(X,DA)    ;This is the kill logic for the function string.
    109         ;Do not execute as part of a verify fields.
    110         I $G(DIUTIL)="VERIFY FIELDS" Q
    111         ;Do not execute as part of exchange.
    112         I $G(PXRMEXCH) Q
    113         K ^PXD(811.9,DA(1),25,DA,5),^PXD(811.9,DA(1),25,DA,10)
    114         Q
    115         ;
    116         ;=============================================================
    117 ISGRV(VAR)      ;Return true if VAR is a global reminder variable.
    118         I VAR="PXRMAGE" Q 1
    119         I VAR="PXRMDOB" Q 1
    120         I VAR="PXRMLAD" Q 1
    121         I VAR="PXRMSEX" Q 1
    122         Q 0
    123         ;
    124         ;=============================================================
    125 ISSTR(STRING)   ;Return true if STRING really is a string and it is not
    126         ;executable Mumps code.
    127         N VALID,X
    128         S VALID=0
    129         ;Valid strings are "text" or because of $P ,"text" or ",U".
    130         I $E(STRING,1)="""",$E(STRING,$L(STRING))="""" S VALID=1
    131         I 'VALID,$E(STRING,1)=",",$E(STRING,2)="""",$E(STRING,$L(STRING))="""" S VALID=1
    132         I 'VALID,STRING=",U" S VALID=1
    133         I 'VALID Q VALID
    134         S X=STRING
    135         D ^DIM
    136         S VALID=$S($D(X)=0:1,1:0)
    137         Q VALID
    138         ;
    139         ;=============================================================
    140 PSPACE(OPR)     ;OPR is an operand in a function finding, if some portion
    141         ;of OPR is a string translate a space into "~" so it is preserved.
    142         ;Note this will work for the entire function string.
    143         N DONE,END,START,TNS,TS
    144         S DONE=0,END=1
    145         F  Q:DONE  D
    146         . S START=$F(OPR,"""",END)
    147         . I START=0 S DONE=1 Q
    148         . S END=$F(OPR,"""",START)
    149         . S TS=$E(OPR,START,END-2)
    150         . S TNS=$TR(TS," ","~")
    151         . S OPR=$$STRREP^PXRMUTIL(OPR,TS,TNS)
    152         Q OPR
    153         ;
    154         ;=============================================================
    155 VFFORM(TEMP,X)  ;Make sure the function has a valid form, i.e., function
    156         ;followed by an argument list.
    157         N DONE,LP,RP,START,VALID
    158         S DONE=0,VALID=1,START=0
    159         F  Q:DONE  D
    160         . S START=$F(X,TEMP,START)
    161         . I START=0 S DONE=1 Q
    162         . S LP=$E(X,START)
    163         . I LP'="(" S VALID=0,DONE=1 Q
    164         . S START=$F(X,")",START)
    165         . S RP=$E(X,START-1)
    166         . I RP'=")" S VALID=0
    167         I 'VALID D
    168         . N TEXT
    169         . S TEXT="Function "_TEMP_" must be followed by an argument list!"
    170         . D EN^DDIOL(.TEXT)
    171         Q VALID
    172         ;
    173         ;=============================================================
    174 VFINDING(X,DAI) ;Make sure a finding number is a valid member of the
    175         ;definition finding multiple. Input transform for function
    176         ;finding finding number.
    177         ;Do not execute as part of a verify fields.
    178         I $G(DIUTIL)="VERIFY FIELDS" Q 1
    179         ;Do not execute as part of exchange.
    180         I $G(PXRMEXCH) Q 1
    181         I '$D(DAI) Q 1
    182         ;If X is not numeric it is not a finding number.
    183         I +X'=X Q 1
    184         I $D(^PXD(811.9,DAI,20,X,0)) Q 1
    185         E  D  Q 0
    186         . N TEXT
    187         . S TEXT="Finding number "_X_" does not exist!"
    188         . D EN^DDIOL(TEXT)
    189         ;
    190         ;=============================================================
    191 VFSTRING(FFSTRING,DA)   ;Make sure a function finding string is valid.
    192         ;The elements can be functions, operators, and numbers.
    193         ;Do not execute as part of a verify fields.
    194         I $G(DIUTIL)="VERIFY FIELDS" Q 1
    195         ;Do not execute as part of exchange.
    196         I $G(PXRMEXCH) Q 1
    197         I '$D(DA) Q 1
    198         N DAI,DATE,FUNIEN,IND,LIST,MFUN,OPER,PFSTACK,TEMP,TEXT,VALID
    199         S DAI=DA(1)
    200         S OPER="!&-+<>='"
    201         ;Define the allowed M functions.
    202         S MFUN("$P")=""
    203         D POSTFIX^PXRMSTAC(FFSTRING,OPER,.PFSTACK)
    204         S VALID=1
    205         F IND=1:1:PFSTACK(0) Q:'VALID  D
    206         . S TEMP=PFSTACK(IND)
    207         . I $D(^PXRMD(802.4,"B",TEMP)) D  Q
    208         .. S VALID=$$VFFORM(TEMP,X)
    209         .. I 'VALID Q
    210         .. S FUNIEN=$O(^PXRMD(802.4,"B",TEMP,""))
    211         .. S IND=IND+1
    212         .. S LIST=$G(PFSTACK(IND))
    213         .. S VALID=$$VLIST(LIST,DAI,TEMP,FUNIEN)
    214         .;Check for operator
    215         . I OPER[TEMP Q
    216         .;Check for number
    217         . I TEMP=+TEMP Q
    218         .;Check for allowed M function.
    219         . I $D(MFUN(TEMP)) Q
    220         .;Check for a global reminder variable
    221         . I $$ISGRV(TEMP) Q
    222         .;Check for a non-executable string.
    223         . I $$ISSTR(TEMP) Q
    224         . S VALID=0
    225         . S TEXT=TEMP_" is not a valid Function Finding element!"
    226         . D EN^DDIOL(TEXT)
    227         I VALID D
    228         . N X
    229         . S X="I "_FFSTRING
    230         . D ^DIM
    231         . I $D(X)=0 S VALID=0
    232         I 'VALID D
    233         . S TEMP=FFSTRING_" is not a valid function string"
    234         . D EN^DDIOL(TEMP)
    235         Q VALID
    236         ;
    237         ;=============================================================
    238 VLIST(LIST,DAI,FUNCTION,FUNIEN) ;Make sure the function argument list
    239         ;is valid.
    240         N AT,IND,LEN,PATTERN,VALID,X
    241         S LEN=$L(LIST,",")
    242         I LEN=0 D  Q 0
    243         . N TEXT
    244         . S TEXT="The argument list is not defined!"
    245         . D EN^DDIOL(TEXT)
    246         S PATTERN=$P(^PXRMD(802.4,FUNIEN,0),U,5)
    247         S VALID=$S(LIST?@PATTERN:1,1:0)
    248         I 'VALID D  Q 0
    249         . N TEXT
    250         . S TEXT="Argument list "_LIST_" is not correct for function "_$P(^PXRMD(802.4,FUNIEN,0),U,1)
    251         . D EN^DDIOL(TEXT)
    252         F IND=1:1:LEN D
    253         . S X=$P(LIST,",",IND)
    254         . S AT=$$ARGTYPE^PXRMFFAT(FUNCTION,IND)
    255         . I AT="U" S VALID=0 Q
    256         . I AT="F",'$$VFINDING(X,DAI) S VALID=0
    257         Q VALID
    258         ;
     1PXRMFFDB ;SLC/PKR - Function finding data structure builder. ;06/22/2006
     2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
     3 ;
     4 ;===========================================
     5BASE2(NUM) ;Convert a base 10 integer to base 2.
     6 N BD,BIN
     7 S BIN=""
     8 F  Q:NUM=0  D
     9 . S BD=$S((NUM\2)=(NUM/2):0,1:1)
     10 . S BIN=BD_BIN,NUM=NUM\2
     11 Q BIN
     12 ;
     13 ;===========================================
     14CRESLOG(NUM,FLIST,RESLOG) ;Check the resolution logic to see if
     15 ;it can be made true solely by function findings. If that is the case
     16 ;warn the user. Called by BLDRESLS^PXRMLOGX
     17 N AGEFI,BP,FI,FF,FFL,IND,JND,KND,LE,LEN,LND,NFF,NTC,SEXFI,TEMP,VALUE
     18 S (AGEFI,SEXFI)=0
     19 S NFF=0
     20 F IND=1:1:NUM D
     21 . S JND=$P(FLIST,";",IND)
     22 . I +JND=JND S FI(JND)=0 Q
     23 . I JND["FF" S NFF=NFF+1,FF=$P(JND,"FF",2),FFL(NFF)=FF
     24 I NFF=0 Q
     25 ;Generate and test all combinations of true and false FFs.
     26 S VALUE=0
     27 S NTC=$$PWR^XLFMTH(2,NFF)-1
     28 F IND=1:1:NTC Q:VALUE  D
     29 . S BIN=$$BASE2(IND)
     30 . S LEN=$L(BIN)
     31 . S LE=NFF-LEN
     32 .;Fill in the values for the implied preceeding 0s.
     33 . F JND=1:1:LE S KND=FFL(JND),FF(KND)=0
     34 . S LND=0
     35 . F JND=LE+1:1:NFF D
     36 .. S KND=FFL(JND),LND=LND+1
     37 .. S FF(KND)=$E(BIN,LND)
     38 . I @RESLOG
     39 . S VALUE=$T
     40 I VALUE D
     41 . N RESLSTR
     42 . S RESLSTR=RESLOG
     43 . F IND=1:1:NUM D
     44 .. S JND=$P(FLIST,";",IND)
     45 .. S TEMP=$S(JND["FF":"FF("_$P(JND,"FF",2)_")",1:"FI("_JND_")")
     46 .. S RESLOG=$$STRREP^PXRMUTIL(RESLOG,TEMP,@TEMP)
     47 . S RESLOG=$$STRREP^PXRMUTIL(RESLOG,"AGE",AGEFI)
     48 . S RESLOG=$$STRREP^PXRMUTIL(RESLOG,"SEX",SEXFI)
     49 . W !!,"Warning - your resolution logic can be satisfied by function findings only."
     50 . W !,"If this happens it will not be possible to calculate a resolution date and"
     51 . W !,"the reminder will not be resolved. Here is a case where the logic evaluates"
     52 . W !,"to true:"
     53 . W !,RESLSTR
     54 . W !,RESLOG
     55 . W !
     56 Q
     57 ;
     58 ;=============================================================
     59FFBUILD(X,DA) ;Given a function finding logical string build the data
     60 ;structure. This is called by a new-style cross-reference after
     61 ;the function string has passed the input transform so we don't need
     62 ;to validate the elements.
     63 ;Do not execute as part of a verify fields.
     64 I $G(DIUTIL)="VERIFY FIELDS" Q
     65 ;Do not execute as part of exchange.
     66 I $G(PXRMEXCH) Q
     67 N FDA,FUNNUM,FUNP,IENB,IENS,IND,JND,L2,L3,LEN,LIST,LOGIC,OPER,MSG
     68 N PFSTACK,REPL,RS,TEMP,TS,XS
     69 S IENB=DA_","_DA(1)_","
     70 S OPER="!&<>='"
     71 S XS=$$PSPACE(X)
     72 D POSTFIX^PXRMSTAC(XS,OPER,.PFSTACK)
     73 S (FUNNUM,L2)=0
     74 F IND=1:1:PFSTACK(0) D
     75 . S TEMP=PFSTACK(IND)
     76 . I $D(^PXRMD(802.4,"B",TEMP)) D
     77 .. S FUNP=$O(^PXRMD(802.4,"B",TEMP,""))
     78 .. S FUNNUM=FUNNUM+1,L2=L2+1
     79 .. S IENS="+"_L2_","_IENB
     80 .. S FDA(811.9255,IENS,.01)=FUNNUM
     81 .. S FDA(811.9255,IENS,.02)=FUNP
     82 .. S IND=IND+1
     83 .. S LIST=$TR(PFSTACK(IND),"~"," ")
     84 .. S REPL(FUNNUM)=TEMP_"("_LIST_")"_U_"FN("_FUNNUM_")"
     85 .. S L3=L2
     86 .. S LEN=$L(LIST,",")
     87 .. F JND=1:1:LEN D
     88 ... S L3=L3+1
     89 ... S IENS="+"_L3_",+"_L2_","_IENB
     90 ... S TS=$P(LIST,",",JND)
     91 ... S TS=$TR(TS,"""","")
     92 ... S FDA(811.9256,IENS,.01)=TS
     93 .. S L2=L3
     94 ;Build the logic string
     95 S LOGIC=X
     96 F IND=1:1:FUNNUM D
     97 . S TS=$P(REPL(IND),U,1)
     98 . S RS=$P(REPL(IND),U,2)
     99 . S LOGIC=$$STRREP^PXRMUTIL(LOGIC,TS,RS)
     100 S FDA(811.925,IENB,10)=LOGIC
     101 D UPDATE^DIE("","FDA","IENB","MSG")
     102 I $D(MSG) D
     103 . W !,"The update failed, UPDATE^DIE returned the following error message:"
     104 . D AWRITE^PXRMUTIL("MSG")
     105 Q
     106 ;
     107 ;=============================================================
     108FFKILL(X,DA) ;This is the kill logic for the function string.
     109 ;Do not execute as part of a verify fields.
     110 I $G(DIUTIL)="VERIFY FIELDS" Q
     111 ;Do not execute as part of exchange.
     112 I $G(PXRMEXCH) Q
     113 K ^PXD(811.9,DA(1),25,DA,5),^PXD(811.9,DA(1),25,DA,10)
     114 Q
     115 ;
     116 ;=============================================================
     117ISGRV(VAR) ;Return true if VAR is a global reminder variable.
     118 I VAR="PXRMAGE" Q 1
     119 I VAR="PXRMDOB" Q 1
     120 I VAR="PXRMLAD" Q 1
     121 I VAR="PXRMSEX" Q 1
     122 Q 0
     123 ;
     124 ;=============================================================
     125ISSTR(STRING) ;Return true if STRING really is a string and it is not
     126 ;executable Mumps code.
     127 N VALID,X
     128 S VALID=0
     129 ;Valid strings are "text" or because of $P ,"text" or ",U".
     130 I $E(STRING,1)="""",$E(STRING,$L(STRING))="""" S VALID=1
     131 I 'VALID,$E(STRING,1)=",",$E(STRING,2)="""",$E(STRING,$L(STRING))="""" S VALID=1
     132 I 'VALID,STRING=",U" S VALID=1
     133 I 'VALID Q VALID
     134 S X=STRING
     135 D ^DIM
     136 S VALID=$S($D(X)=0:1,1:0)
     137 Q VALID
     138 ;
     139 ;=============================================================
     140PSPACE(OPR) ;OPR is an operand in a function finding, if some portion
     141 ;of OPR is a string translate a space into "~" so it is preserved.
     142 N END,START,TNS,TS
     143 S START=$F(OPR,"""")
     144 I START=0 Q OPR
     145 S END=$F(OPR,"""",START)-2
     146 S TS=$E(OPR,START,END)
     147 S TNS=$TR(TS," ","~")
     148 S OPR=$$STRREP^PXRMUTIL(OPR,TS,TNS)
     149 Q OPR
     150 ;
     151 ;=============================================================
     152VFFORM(TEMP,X) ;Make sure the function has a valid form, i.e., function
     153 ;followed by an argument list.
     154 N DONE,LP,RP,START,VALID
     155 S DONE=0,VALID=1,START=0
     156 F  Q:DONE  D
     157 . S START=$F(X,TEMP,START)
     158 . I START=0 S DONE=1 Q
     159 . S LP=$E(X,START)
     160 . I LP'="(" S VALID=0,DONE=1 Q
     161 . S START=$F(X,")",START)
     162 . S RP=$E(X,START-1)
     163 . I RP'=")" S VALID=0
     164 I 'VALID D
     165 . N TEXT
     166 . S TEXT="Function "_TEMP_" must be followed by an argument list!"
     167 . D EN^DDIOL(.TEXT)
     168 Q VALID
     169 ;
     170 ;=============================================================
     171VFINDING(X,DAI) ;Make sure a finding number is a valid member of the
     172 ;definition finding multiple. Input transform for function
     173 ;finding finding number.
     174 ;Do not execute as part of a verify fields.
     175 I $G(DIUTIL)="VERIFY FIELDS" Q 1
     176 ;Do not execute as part of exchange.
     177 I $G(PXRMEXCH) Q 1
     178 I '$D(DAI) Q 1
     179 ;If X is not numeric it is not a finding number.
     180 I +X'=X Q 1
     181 I $D(^PXD(811.9,DAI,20,X,0)) Q 1
     182 E  D  Q 0
     183 . N TEXT
     184 . S TEXT="Finding number "_X_" does not exist!"
     185 . D EN^DDIOL(TEXT)
     186 ;
     187 ;=============================================================
     188VFSTRING(FFSTRING,DA) ;Make sure a function finding string is valid.
     189 ;The elements can be functions, operators, and numbers.
     190 ;Do not execute as part of a verify fields.
     191 I $G(DIUTIL)="VERIFY FIELDS" Q 1
     192 ;Do not execute as part of exchange.
     193 I $G(PXRMEXCH) Q 1
     194 I '$D(DA) Q 1
     195 N DAI,DATE,FUNIEN,IND,LIST,MFUN,OPER,PFSTACK,TEMP,TEXT,VALID
     196 S DAI=DA(1)
     197 S OPER="!&<>='"
     198 ;Define the allowed M functions.
     199 S MFUN("$P")=""
     200 D POSTFIX^PXRMSTAC(FFSTRING,OPER,.PFSTACK)
     201 S VALID=1
     202 F IND=1:1:PFSTACK(0) Q:'VALID  D
     203 . S TEMP=PFSTACK(IND)
     204 . I $D(^PXRMD(802.4,"B",TEMP)) D  Q
     205 .. S VALID=$$VFFORM(TEMP,X)
     206 .. I 'VALID Q
     207 .. S FUNIEN=$O(^PXRMD(802.4,"B",TEMP,""))
     208 .. S IND=IND+1
     209 .. S LIST=$G(PFSTACK(IND))
     210 .. S VALID=$$VLIST(LIST,DAI,TEMP,FUNIEN)
     211 .;Check for operator
     212 . I OPER[TEMP Q
     213 .;Check for number
     214 . I TEMP=+TEMP Q
     215 .;Check for allowed M function.
     216 . I $D(MFUN(TEMP)) Q
     217 .;Check for a global reminder variable
     218 . I $$ISGRV(TEMP) Q
     219 .;Check for a non-executable string.
     220 . I $$ISSTR(TEMP) Q
     221 . S VALID=0
     222 . S TEXT=TEMP_" is not a valid Function Finding element!"
     223 . D EN^DDIOL(TEXT)
     224 I VALID D
     225 . N X
     226 . S X="I "_FFSTRING
     227 . D ^DIM
     228 . I $D(X)=0 S VALID=0
     229 I 'VALID D
     230 . S TEMP=FFSTRING_" is not a valid function string"
     231 . D EN^DDIOL(TEMP)
     232 Q VALID
     233 ;
     234 ;=============================================================
     235VLIST(LIST,DAI,FUNCTION,FUNIEN) ;Make sure the function argument list
     236 ;is valid.
     237 N AT,IND,LEN,PATTERN,VALID,X
     238 S LEN=$L(LIST,",")
     239 I LEN=0 D  Q 0
     240 . N TEXT
     241 . S TEXT="The argument list is not defined!"
     242 . D EN^DDIOL(TEXT)
     243 S PATTERN=$P(^PXRMD(802.4,FUNIEN,0),U,5)
     244 S VALID=$S(LIST?@PATTERN:1,1:0)
     245 I 'VALID D  Q 0
     246 . N TEXT
     247 . S TEXT="Argument list "_LIST_" is not correct for function "_$P(^PXRMD(802.4,FUNIEN,0),U,1)
     248 . D EN^DDIOL(TEXT)
     249 F IND=1:1:LEN D
     250 . S X=$P(LIST,",",IND)
     251 . S AT=$$ARGTYPE^PXRMFFAT(FUNCTION,IND)
     252 . I AT="U" S VALID=0 Q
     253 . I AT="F",'$$VFINDING(X,DAI) S VALID=0
     254 Q VALID
     255 ;
Note: See TracChangeset for help on using the changeset viewer.