DIS0 ;SFISC/GFT-SEARCH, IF STATEMENT AND MULTIPLE COMBO'S ;30JAN2005
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
W ! K R,N,DL,DE,DJ
S O=0,E=$D(DC(2)),N="IF: A// ",DE=$S(E:"IF: ",1:N),DL=0
S C=","
R W !,DE K DV R X:DTIME S:'$T DTOUT=1 G Q:X[U!'$T
I X="" S DV=1,DU=X G 1:DL S DQ="TYPE '^' TO EXIT",Y="^1^",DL=1 G BAD:E D ASKQ G L
S Y=U,P=0,DU="",D="",DL=DL+1
P S P=P+1,DQ=$E(X,P) I DQ="" G BAD:Y=U,L
I DQ?.A S DV=$A(DQ)-64 I $D(DC(DV)) D ASKQ G CHK
G P:"&+ "[DQ I DU="","'-"[DQ S DU="'" G P
BAD D W !! K DJ(DL),DE(DL) S DL=DL-1 G R
.I DQ?."?" D BLD^DIALOG($S($D(DC(2)):8004.2,1:8004.1)),MSG^DIALOG("WH") Q ;HELP depending on whether there is a CONDITION B
.W " <",DQ,">??"
;
ASKQ S J=DC(DV),%=J["?."" """,I=J["^'"+(DU["'")#2 I J["W^" S DV(DV)=$S(I:2-%,1:%+%+1) S:% DC(DV)=$E(J,1,$L(J)-5)_"=""""" Q
S:$P(J,U)[C DV(DV)=J?.E1",.01^".E&%+(I+%#2) Q
;
CHK S %=$F(Y,U_DV) I % S %=$P($E(Y,%),U,1)'=DU,DQ=""""_DQ_""" AND """_$E("'",%)_DQ_""" IS "_$P("REDUNDANT^CONTRADICTORY",U,%+1) G BAD
S %=1,Y=Y_DV_DU_U,DU="",J=$P(DC(DV),U,1) G P:J'[C F Z=2:1 I $P(J,C,Z,99)'[C S J=$P(J,C,1,Z-1)_C Q
I J=D D SAMEQ S:%=1 DJ(DL,DV)=DX(DV)
S D=J,DJ=DV G P:%>0
Q G Q^DIS2
;
SAMEQ I J<0,$P(DY(-J),U,3)="" Q
W !?8,"CONDITION -"_$C(DV+64)_"- WILL APPLY TO THE SAME MULTIPLE AS CONDITION -"_$C(DJ+64)_"-",!?8,"...OK" G YN^DICN
;
L S P=O,DL(DL)=Y,DE="OR: " F %=2:1 S X=$P(Y,U,%) Q:X="" S O=O+1,^UTILITY($J,O,0)=$S(%>2:$S($D(DJ(DL,+X)):" together with ",1:" and "),O=1:"",1:" Or ")_$P("not ",U,X["'")_O(+X)
W:$X>18 ! W " " F %=P+1:1 Q:'$D(^UTILITY($J,%,0)) S X=^(0) W:$L(X)+$X>77 !?13 W " "_$P(X,U) I $P(X,U,2)'="" W " ("_$P(X,U,2)_")"
S DV=0
DV S DV=$O(DV(DV)) S:DV="" DV=-1 G:DV'>0 R:E,1 G DV:$D(DJ(DL,DV)) S I=$P(DC(DV),U,1),D=DK,DN=0,Y="DO YOU WANT THIS SEARCH SPECIFICATION TO BE CONSIDERED TRUE FOR CONDITION -"_$C(DV+64)_"-"
G S DN=DN+1,P=$P(I,C,1),I=$P(I,C,2,99) G W:P["W",DV:I="" I P<0 S J=DY(-P),D=+J,R=" '"_$P(^DIC(D,0),U,1)_"' ENTRIES " G G:'$P(J,U,3)
E S D=+$P(^DD(D,P,0),U,2),R=" '"_$O(^DD(D,0,"NM",0))_"' MULTIPLES "
HOW W !!,Y,!?8,"1) WHEN AT LEAST ONE OF THE"_R_"SATISFIES IT"
W !?8,"2) WHEN ALL OF THE"_R_"SATISFY IT" S X=2
I DV(DV) W !?8,"3) WHEN ALL OF THE"_R_"SATISFY IT,",!?16,"OR WHEN THERE ARE NO"_R S X=3
W !?4,"CHOOSE 1-"_X_": " I DV(DV)>1 W 3 S %1=3
E W 1 S %1=1
R "// ",%:DTIME,! S:'$T DTOUT=1 S:%="" %=%1 K %1 G Q:%=U!'$T,HOW:%>X!'% I %>1 S DE(DL,DV,DN)=%,O=O+1,^UTILITY($J,O,0)=" for all"_R_$P(", or when no"_R_"exist",U,%>2)
G G
;
W I DV(DV)-2 S DE(DL,DV,DN)=DV(DV) G DV
W !!,Y,!?7,"WHEN THERE IS NO '"_$P(^DD(D,+P,0),U,1)_"' TEXT AT ALL"
S %=1 D YN^DICN G Q:%<0,W:'% S DE(DL,DV,DN)=4-% G DV
;
1 K O,DX,Y G ^DIS1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIS0 2967 printed Nov 22, 2024@18:03:55 Page 2
DIS0 ;SFISC/GFT-SEARCH, IF STATEMENT AND MULTIPLE COMBO'S ;30JAN2005
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 WRITE !
KILL R,N,DL,DE,DJ
+8 SET O=0
SET E=$DATA(DC(2))
SET N="IF: A// "
SET DE=$SELECT(E:"IF: ",1:N)
SET DL=0
+9 SET C=","
R WRITE !,DE
KILL DV
READ X:DTIME
if '$TEST
SET DTOUT=1
if X[U!'$TEST
GOTO Q
+1 IF X=""
SET DV=1
SET DU=X
if DL
GOTO 1
SET DQ="TYPE '^' TO EXIT"
SET Y="^1^"
SET DL=1
if E
GOTO BAD
DO ASKQ
GOTO L
+2 SET Y=U
SET P=0
SET DU=""
SET D=""
SET DL=DL+1
P SET P=P+1
SET DQ=$EXTRACT(X,P)
IF DQ=""
if Y=U
GOTO BAD
GOTO L
+1 IF DQ?.A
SET DV=$ASCII(DQ)-64
IF $DATA(DC(DV))
DO ASKQ
GOTO CHK
+2 if "&+ "[DQ
GOTO P
IF DU=""
IF "'-"[DQ
SET DU="'"
GOTO P
BAD Begin DoDot:1
+1 ;HELP depending on whether there is a CONDITION B
IF DQ?."?"
DO BLD^DIALOG($SELECT($DATA(DC(2)):8004.2,1:8004.1))
DO MSG^DIALOG("WH")
QUIT
+2 WRITE " <",DQ,">??"
End DoDot:1
WRITE !!
KILL DJ(DL),DE(DL)
SET DL=DL-1
GOTO R
+3 ;
ASKQ SET J=DC(DV)
SET %=J["?."" """
SET I=J["^'"+(DU["'")#2
IF J["W^"
SET DV(DV)=$SELECT(I:2-%,1:%+%+1)
if %
SET DC(DV)=$EXTRACT(J,1,$LENGTH(J)-5)_"="""""
QUIT
+1 if $PIECE(J,U)[C
SET DV(DV)=J?.E1",.01^".E&%+(I+%#2)
QUIT
+2 ;
CHK SET %=$FIND(Y,U_DV)
IF %
SET %=$PIECE($EXTRACT(Y,%),U,1)'=DU
SET DQ=""""_DQ_""" AND """_$EXTRACT("'",%)_DQ_""" IS "_$PIECE("REDUNDANT^CONTRADICTORY",U,%+1)
GOTO BAD
+1 SET %=1
SET Y=Y_DV_DU_U
SET DU=""
SET J=$PIECE(DC(DV),U,1)
if J'[C
GOTO P
FOR Z=2:1
IF $PIECE(J,C,Z,99)'[C
SET J=$PIECE(J,C,1,Z-1)_C
QUIT
+2 IF J=D
DO SAMEQ
if %=1
SET DJ(DL,DV)=DX(DV)
+3 SET D=J
SET DJ=DV
if %>0
GOTO P
Q GOTO Q^DIS2
+1 ;
SAMEQ IF J<0
IF $PIECE(DY(-J),U,3)=""
QUIT
+1 WRITE !?8,"CONDITION -"_$CHAR(DV+64)_"- WILL APPLY TO THE SAME MULTIPLE AS CONDITION -"_$CHAR(DJ+64)_"-",!?8,"...OK"
GOTO YN^DICN
+2 ;
L SET P=O
SET DL(DL)=Y
SET DE="OR: "
FOR %=2:1
SET X=$PIECE(Y,U,%)
if X=""
QUIT
SET O=O+1
SET ^UTILITY($JOB,O,0)=$SELECT(%>2:$SELECT($DATA(DJ(DL,+X)):" together with ",1:" and "),O=1:"",1:" Or ")_$PIECE("not ",U,X["'")_O(+X)
+1 if $X>18
WRITE !
WRITE " "
FOR %=P+1:1
if '$DATA(^UTILITY($JOB,%,0))
QUIT
SET X=^(0)
if $LENGTH(X)+$X>77
WRITE !?13
WRITE " "_$PIECE(X,U)
IF $PIECE(X,U,2)'=""
WRITE " ("_$PIECE(X,U,2)_")"
+2 SET DV=0
DV SET DV=$ORDER(DV(DV))
if DV=""
SET DV=-1
if DV'>0
if E
GOTO R
GOTO 1
if $DATA(DJ(DL,DV))
GOTO DV
SET I=$PIECE(DC(DV),U,1)
SET D=DK
SET DN=0
SET Y="DO YOU WANT THIS SEARCH SPECIFICATION TO BE CONSIDERED TRUE FOR CONDITION -"_$CHAR(DV+64)_"-"
G SET DN=DN+1
SET P=$PIECE(I,C,1)
SET I=$PIECE(I,C,2,99)
if P["W"
GOTO W
if I=""
GOTO DV
IF P<0
SET J=DY(-P)
SET D=+J
SET R=" '"_$PIECE(^DIC(D,0),U,1)_"' ENTRIES "
if '$PIECE(J,U,3)
GOTO G
+1 IF '$TEST
SET D=+$PIECE(^DD(D,P,0),U,2)
SET R=" '"_$ORDER(^DD(D,0,"NM",0))_"' MULTIPLES "
HOW WRITE !!,Y,!?8,"1) WHEN AT LEAST ONE OF THE"_R_"SATISFIES IT"
+1 WRITE !?8,"2) WHEN ALL OF THE"_R_"SATISFY IT"
SET X=2
+2 IF DV(DV)
WRITE !?8,"3) WHEN ALL OF THE"_R_"SATISFY IT,",!?16,"OR WHEN THERE ARE NO"_R
SET X=3
+3 WRITE !?4,"CHOOSE 1-"_X_": "
IF DV(DV)>1
WRITE 3
SET %1=3
+4 IF '$TEST
WRITE 1
SET %1=1
+5 READ "// ",%:DTIME,!
if '$TEST
SET DTOUT=1
if %=""
SET %=%1
KILL %1
if %=U!'$TEST
GOTO Q
if %>X!'%
GOTO HOW
IF %>1
SET DE(DL,DV,DN)=%
SET O=O+1
SET ^UTILITY($JOB,O,0)=" for all"_R_$PIECE(", or when no"_R_"exist",U,%>2)
+6 GOTO G
+7 ;
W IF DV(DV)-2
SET DE(DL,DV,DN)=DV(DV)
GOTO DV
+1 WRITE !!,Y,!?7,"WHEN THERE IS NO '"_$PIECE(^DD(D,+P,0),U,1)_"' TEXT AT ALL"
+2 SET %=1
DO YN^DICN
if %<0
GOTO Q
if '%
GOTO W
SET DE(DL,DV,DN)=4-%
GOTO DV
+3 ;
1 KILL O,DX,Y
GOTO ^DIS1
