| 1 | TMGDIS0 ;TMG/kst/Custom DIS0, non-interactive SEARCH, IF STATEMENT AND MULTIPLE COMBO'S ;5/13/10 ; 5/16/10 10:01pm
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;01/01/06
|
|---|
| 3 | ;-----Prior header below -------------
|
|---|
| 4 | ;SFISC/GFT-SEARCH, IF STATEMENT AND MULTIPLE COMBO'S ;30JAN2005
|
|---|
| 5 | ;;22.0;VA FileMan;**144**;Mar 30, 1999;Build 5
|
|---|
| 6 | ;
|
|---|
| 7 | DIS0(TMGINFO,TMGOUT,TMGBYROOT) ;
|
|---|
| 8 | ;"Purpose: Provide an API interface for the classic Fileman console search
|
|---|
| 9 | ;"Input: TMGINFO -- PASS BY REFERENCE. This is pre-defined search terms. Format:
|
|---|
| 10 | ;" TMGINFO("FILE") -- File name or number to be used for search
|
|---|
| 11 | ;" TMGINFO(1,...) -- Search condition 1 (corresponds to 'A' in console)
|
|---|
| 12 | ;" TMGINFO(2,...) -- Search condition 2 (corresponds to 'B' in console)
|
|---|
| 13 | ;" TMGINFO("LOGIC-IF")=(OPTIONAL) Logic string that would be normally
|
|---|
| 14 | ;" entered at 'IF: ' prompt
|
|---|
| 15 | ;" e.g. "1&2", or "A&B", or "AB" <--- all the same
|
|---|
| 16 | ;" Default is logic string ANDing all search terms.
|
|---|
| 17 | ;" TMGINFO("LOGIC-OR",1)=(OPTIONAL) Logic string that would be normally
|
|---|
| 18 | ;" entered at 'OR: ' prompt
|
|---|
| 19 | ;" TMGINFO("LOGIC-OR",#)=(OPTIONAL) Logic string that would be normally
|
|---|
| 20 | ;" entered at 'OR: ' prompt. #=2,3,4... For multiple
|
|---|
| 21 | ;" lines of OR logic
|
|---|
| 22 | ;" NOTE: Fileman console labels search terms as "A","B","C",...
|
|---|
| 23 | ;" But the above numbering system uses "1","2","3",...
|
|---|
| 24 | ;" When entering in logic strings, one may use either letters
|
|---|
| 25 | ;" or numbers. A=1, B=2 etc. Note that Fileman allows AB to
|
|---|
| 26 | ;" mean the same as A&B. This is not possible with numbers.
|
|---|
| 27 | ;" ...
|
|---|
| 28 | ;" --DETAILS ON SEARCH CONDITION----
|
|---|
| 29 | ;" TMGINFO(n,"FLD") -- The Fileman field name or number to seach in
|
|---|
| 30 | ;" TMGINFO(n,"COND") -- The condition: "=,>,<,[,?,NULL" Prefix ' or - to negate
|
|---|
| 31 | ;" TMGINFO(n,"VALUE") -- the value to search for
|
|---|
| 32 | ;" TMGOUT --An OUT PARAMETER. Prior values killed. Format:
|
|---|
| 33 | ;" TMGOUT(FILENUM,IEN)=""
|
|---|
| 34 | ;" TMGOUT(FILENUM,IEN)=""
|
|---|
| 35 | ;" TMGOUT(FILENUM,IEN)=""
|
|---|
| 36 | ;" TMGBYROOT -- (Optional) If 1, then TMGOUT is treated as a variable NAME (root)
|
|---|
| 37 | ;" i.e. @TMGOUT@(FILENUM,IEN)=""
|
|---|
| 38 | ;"Globally-Scoped variables uses: O,DC,DA (and probably others)
|
|---|
| 39 | ;"Results: 1 if OK, or -1^Error Message
|
|---|
| 40 | ;
|
|---|
| 41 | ;"WRITE !
|
|---|
| 42 | NEW TMGRESULT SET TMGRESULT=1 ;"Default to success
|
|---|
| 43 | NEW R,N,DL,DE,DJ ;"WAS KILL initially
|
|---|
| 44 | NEW P,LOGIC,NLOG
|
|---|
| 45 | NEW DU
|
|---|
| 46 | SET O=0
|
|---|
| 47 | SET E=$DATA(DC(2)) ;"E>0 IF MORE THAN ONE SRCH TERM
|
|---|
| 48 | SET N="IF: A// "
|
|---|
| 49 | SET DE=$SELECT(E:"IF: ",1:N)
|
|---|
| 50 | NEW TMGLMODE SET TMGLMODE=1 ;"1="LOGIC-IF" 2=LOGIC-OR
|
|---|
| 51 | NEW TMGLORN SET TMGLORN=0 ;"Logic OR line number
|
|---|
| 52 | SET DL=0
|
|---|
| 53 | SET C=","
|
|---|
| 54 | R ;"WRITE !,DE
|
|---|
| 55 | KILL DV
|
|---|
| 56 | IF TMGLMODE=1 DO
|
|---|
| 57 | . SET X=$GET(INFO("LOGIC-IF"))
|
|---|
| 58 | . IF X'="" QUIT
|
|---|
| 59 | . NEW I SET I=0
|
|---|
| 60 | . FOR SET I=$ORDER(INFO(I)) QUIT:+I'>0 SET X=X_$CHAR(I+64)
|
|---|
| 61 | . SET INFO("LOGIC-IF")=X
|
|---|
| 62 | ELSE DO
|
|---|
| 63 | . SET TMGLORN=TMGLORN+1
|
|---|
| 64 | . SET X=$GET(INFO("LOGIC-OR",TMGLORN))
|
|---|
| 65 | IF X'="" GOTO R2
|
|---|
| 66 | ;"READ X:DTIME SET:'$T DTOUT=1 GOTO Q:X[U!'$T
|
|---|
| 67 | SET DV=1,DU=X
|
|---|
| 68 | GOTO 1:DL
|
|---|
| 69 | SET DQ="TYPE '^' TO EXIT"
|
|---|
| 70 | SET Y="^1^"
|
|---|
| 71 | SET DL=1
|
|---|
| 72 | ;"GOTO BAD:E
|
|---|
| 73 | IF E="" DO GOTO TMGDONE
|
|---|
| 74 | . SET TMGRESULT="-1^Bad/absent logic string."
|
|---|
| 75 | DO ASKQ(.DC,.DV,.DU)
|
|---|
| 76 | GOTO L
|
|---|
| 77 | ;
|
|---|
| 78 | R2 SET Y=U,P=0,DU="",D=""
|
|---|
| 79 | SET DL=DL+1
|
|---|
| 80 | P ;"PARSE LOGIC STRING
|
|---|
| 81 | SET LOGIC=X,LOGN=0
|
|---|
| 82 | FOR QUIT:(LOGIC="")!(+TMGRESULT=-1) DO
|
|---|
| 83 | . SET DV=0
|
|---|
| 84 | . IF +LOGIC>0 DO
|
|---|
| 85 | . . SET (DV,DQ)=+LOGIC
|
|---|
| 86 | . . SET LOGIC=$EXTRACT($LENGTH(DQ)+1,9999)
|
|---|
| 87 | . ELSE DO
|
|---|
| 88 | . . SET DQ=$EXTRACT(LOGIC,1)
|
|---|
| 89 | . . SET LOGIC=$EXTRACT(LOGIC,2,9999)
|
|---|
| 90 | . . IF DQ?.A SET DV=$ASCII(DQ)-64
|
|---|
| 91 | . IF (DV>0)&($DATA(DC(DV))>0) DO QUIT
|
|---|
| 92 | . . SET LOGN=LOGN+1
|
|---|
| 93 | . . DO ASKQ(.DC,.DV,.DU)
|
|---|
| 94 | . . SET TMGRESULT=$$CHK(DV)
|
|---|
| 95 | . IF "&+ "[DQ QUIT
|
|---|
| 96 | . IF ((DU="")&("'-"[DQ)) SET DU="'" QUIT
|
|---|
| 97 | . SET TMGRESULT="-1^Bad entry '"_DQ_"' found in logic phrase '"_X_"'"
|
|---|
| 98 | IF LOGN'>0 SET TMGRESULT="-1^No valid logic terms found in '"_X_"'"
|
|---|
| 99 | IF +TMGRESULT=-1 GOTO TMGDONE
|
|---|
| 100 | GOTO L
|
|---|
| 101 | ;
|
|---|
| 102 | ;"BAD DO
|
|---|
| 103 | ;" . IF DQ?."?" DO QUIT
|
|---|
| 104 | ;" . . DO BLD^DIALOG($SELECT($DATA(DC(2)):8004.2,1:8004.1))
|
|---|
| 105 | ;" . . DO MSG^DIALOG("WH") ;HELP depending on whether there is a CONDITION B
|
|---|
| 106 | ;" . WRITE " <",DQ,">??"
|
|---|
| 107 | ;" WRITE !!
|
|---|
| 108 | ;" KILL DJ(DL),DE(DL)
|
|---|
| 109 | ;" SET DL=DL-1
|
|---|
| 110 | ;" GOTO R
|
|---|
| 111 | ;
|
|---|
| 112 | ASKQ(DC,DV,DU) ;"-------------
|
|---|
| 113 | NEW J,%,I
|
|---|
| 114 | SET J=DC(DV)
|
|---|
| 115 | SET %=J["?."" """
|
|---|
| 116 | SET I=J["^'"+(DU["'")#2
|
|---|
| 117 | IF J["W^" DO QUIT
|
|---|
| 118 | . SET DV(DV)=$SELECT(I:2-%,1:%+%+1)
|
|---|
| 119 | . IF % SET DC(DV)=$EXTRACT(J,1,$LENGTH(J)-5)_"="""""
|
|---|
| 120 | IF $PIECE(J,U)[C SET DV(DV)=J?.E1",.01^".E&%+(I+%#2)
|
|---|
| 121 | QUIT
|
|---|
| 122 | ;
|
|---|
| 123 | CHK(DV) ;Check search term
|
|---|
| 124 | ;"Result: 1 if OK, -1^ErrorMessage
|
|---|
| 125 | NEW %
|
|---|
| 126 | NEW RSLT SET RSLT=1 ;"Default to success
|
|---|
| 127 | SET %=$F(Y,U_DV)
|
|---|
| 128 | IF % DO GOTO CKDN ;"Was BAD
|
|---|
| 129 | . SET %=$PIECE($EXTRACT(Y,%),U,1)'=DU
|
|---|
| 130 | . SET DQ=""""_DQ_""" AND """_$EXTRACT("'",%)_DQ_""" IS "_$PIECE("REDUNDANT^CONTRADICTORY",U,%+1)
|
|---|
| 131 | . SET RSLT="-1^"_DQ
|
|---|
| 132 | SET %=1
|
|---|
| 133 | SET Y=Y_DV_DU_U
|
|---|
| 134 | SET DU=""
|
|---|
| 135 | SET J=$PIECE(DC(DV),U,1)
|
|---|
| 136 | IF J'[C GOTO CKDN ;"WAS P
|
|---|
| 137 | FOR Z=2:1 IF $PIECE(J,C,Z,99)'[C SET J=$PIECE(J,C,1,Z-1)_C QUIT
|
|---|
| 138 | IF J=D DO
|
|---|
| 139 | . DO SAMEQ ;"result in %
|
|---|
| 140 | . IF %=1 SET DJ(DL,DV)=DX(DV)
|
|---|
| 141 | SET D=J,DJ=DV
|
|---|
| 142 | ;"IF %>0 GOTO P
|
|---|
| 143 | IF %'>0 DO GOTO CKDN
|
|---|
| 144 | . SET RSLT="-1^Error checking search term #"_DV
|
|---|
| 145 | CKDN QUIT RSLT
|
|---|
| 146 | ;"Q GOTO Q^DIS2
|
|---|
| 147 | ;
|
|---|
| 148 | SAMEQ ;----
|
|---|
| 149 | IF (J<0),$PIECE(DY(-J),U,3)="" QUIT
|
|---|
| 150 | ;"NOTE!!!: Answer to question below FORCED TO BE 'YES' FOR NOW. Later figure how to specify in INFO array
|
|---|
| 151 | ;"WRITE !?8,"CONDITION -"_$C(DV+64)_"- WILL APPLY TO THE SAME MULTIPLE AS CONDITION -"_$C(DJ+64)_"-",!?8,"...OK"
|
|---|
| 152 | ;"DO YN^DICN
|
|---|
| 153 | SET %=1 ;"FORCE 'YES' answer
|
|---|
| 154 | QUIT
|
|---|
| 155 | ;
|
|---|
| 156 | ;-----------------
|
|---|
| 157 | L SET P=O
|
|---|
| 158 | SET DL(DL)=Y
|
|---|
| 159 | SET DE="OR: "
|
|---|
| 160 | SET TMGLMODE=2 ;"OR mode
|
|---|
| 161 | FOR %=2:1 SET X=$PIECE(Y,U,%) QUIT:X="" DO
|
|---|
| 162 | . SET O=O+1
|
|---|
| 163 | . NEW S SET S=$SELECT($DATA(DJ(DL,+X)):" together with ",1:" and ")
|
|---|
| 164 | . SET ^UTILITY($J,O,0)=$SELECT(%>2:S,O=1:"",1:" Or ")_$PIECE("not ",U,X["'")_O(+X)
|
|---|
| 165 | ;"WRITE:$X>18 !
|
|---|
| 166 | ;"WRITE " "
|
|---|
| 167 | ;"FOR %=P+1:1 Q:'$DATA(^UTILITY($J,%,0)) DO
|
|---|
| 168 | ;". SET X=^(0)
|
|---|
| 169 | ;". IF $LENGTH(X)+$X>77 WRITE !?13
|
|---|
| 170 | ;". WRITE " "_$PIECE(X,U)
|
|---|
| 171 | ;". IF $PIECE(X,U,2)'="" WRITE " ("_$PIECE(X,U,2)_")"
|
|---|
| 172 | SET DV=0
|
|---|
| 173 | DV SET DV=$ORDER(DV(DV))
|
|---|
| 174 | IF DV="" SET DV=-1
|
|---|
| 175 | ;"GOTO:DV'>0 R:E,1
|
|---|
| 176 | IF (DV'>0)&E GOTO R ;"Go back and ask for OR" logic phrase
|
|---|
| 177 | IF (DV'>0) GOTO 1
|
|---|
| 178 | IF $DATA(DJ(DL,DV)) GOTO DV
|
|---|
| 179 | SET I=$PIECE(DC(DV),U,1),D=DK,DN=0
|
|---|
| 180 | SET Y="DO YOU WANT THIS SEARCH SPECIFICATION TO BE CONSIDERED TRUE FOR CONDITION -"_$C(DV+64)_"-"
|
|---|
| 181 | G SET DN=DN+1
|
|---|
| 182 | SET P=$PIECE(I,C,1)
|
|---|
| 183 | SET I=$PIECE(I,C,2,99)
|
|---|
| 184 | IF P["W" GOTO W
|
|---|
| 185 | IF I="" GOTO DV
|
|---|
| 186 | IF P<0 DO GOTO G:'$PIECE(J,U,3)
|
|---|
| 187 | . SET J=DY(-P)
|
|---|
| 188 | . SET D=+J
|
|---|
| 189 | . SET R=" '"_$PIECE(^DIC(D,0),U,1)_"' ENTRIES "
|
|---|
| 190 | ELSE DO
|
|---|
| 191 | . SET D=+$PIECE(^DD(D,P,0),U,2),R=" '"_$ORDER(^DD(D,0,"NM",0))_"' MULTIPLES "
|
|---|
| 192 | HOW ;
|
|---|
| 193 | ;"NOTE!!! -- I am forcing answers to be the default ones for now. Later figure out how to
|
|---|
| 194 | ;" specify pre-defined answers in the INFO array
|
|---|
| 195 | ;"
|
|---|
| 196 | ;"WRITE !!,Y,!?8,"1) WHEN AT LEAST ONE OF THE"_R_"SATISFIES IT"
|
|---|
| 197 | ;"WRITE !?8,"2) WHEN ALL OF THE"_R_"SATISFY IT" SET X=2
|
|---|
| 198 | ;"IF DV(DV) DO
|
|---|
| 199 | ;". WRITE !?8,"3) WHEN ALL OF THE"_R_"SATISFY IT,",!?16,"OR WHEN THERE ARE NO"_R
|
|---|
| 200 | ;". SET X=3
|
|---|
| 201 | ;"WRITE !?4,"CHOOSE 1-"_X_": "
|
|---|
| 202 | IF DV(DV)>1 DO
|
|---|
| 203 | . ;"WRITE 3
|
|---|
| 204 | . SET %1=3
|
|---|
| 205 | ELSE DO
|
|---|
| 206 | . ;"WRITE 1
|
|---|
| 207 | . SET %1=1
|
|---|
| 208 | ;"READ "// ",%:DTIME,!
|
|---|
| 209 | ;"SET:'$T DTOUT=1 SET:%="" %=%1
|
|---|
| 210 | SET %=%1 ;"//KT
|
|---|
| 211 | KILL %1
|
|---|
| 212 | ;"GOTO Q:%=U!'$T
|
|---|
| 213 | ;"GOTO HOW:%>X!'%
|
|---|
| 214 | IF %>1 DO
|
|---|
| 215 | . SET DE(DL,DV,DN)=%
|
|---|
| 216 | . SET O=O+1
|
|---|
| 217 | . SET ^UTILITY($J,O,0)=" for all"_R_$PIECE(", or when no"_R_"exist",U,%>2)
|
|---|
| 218 | GOTO G
|
|---|
| 219 | ;
|
|---|
| 220 | W IF DV(DV)-2 DO GOTO DV
|
|---|
| 221 | . SET DE(DL,DV,DN)=DV(DV)
|
|---|
| 222 | ;"NOTE!!! I am setting the answer to the question below to the default value.
|
|---|
| 223 | ;" Later figure out how to pass predefined answer in INFO array from programmer
|
|---|
| 224 | ;"WRITE !!,Y,!?7,"WHEN THERE IS NO '"_$PIECE(^DD(D,+P,0),U,1)_"' TEXT AT ALL"
|
|---|
| 225 | SET %=1
|
|---|
| 226 | ;"DO YN^DICN
|
|---|
| 227 | ;"GOTO Q:%<0
|
|---|
| 228 | ;"GOTO W:'%
|
|---|
| 229 | SET DE(DL,DV,DN)=4-%
|
|---|
| 230 | GOTO DV
|
|---|
| 231 | ;
|
|---|
| 232 | 1 KILL DX,Y ;"removed O from kill
|
|---|
| 233 | DO DIS1^TMGDIS1 ;"Sets TMGRESULT, WAS GOTO ^DIS1
|
|---|
| 234 | GOTO TMGDONE
|
|---|
| 235 | ;
|
|---|
| 236 | TMGDONE ;
|
|---|
| 237 | QUIT
|
|---|
