BGUCND ; IHS/OIT/MJL - CONDITION HANDLER ; [ 12/01/2005 3:27 PM ]
;;1.5;BGU;**2**;MAY 26, 2005
;
; BLDCND BUILDS THE CONDITION ARRAY THAT IS USED BY CND TO SET A TRUTH
; VALUE. CALL BLDCND DURING THE CALLING APPLICATIONS INIT OR WHENEVER
; A NEW CONDITON IS NEEDED.
;
; DO INIT FIRST IF TESTING SEPARATELY
;
; USE FOR TESTING -- D INIT,BLDCND,CND
D INIT,BLDCND,CND,KILL
Q
;
KILL ;EP Called by BGULIST
K BGUCARY,BGUCC,BGUCEXP,BGUCEXP1,BGUCF,BGUCFID,BGUCLCNJ,BGUCLSEG,BGUCLV,BGUCMXL,BGUCN,BGUCN1,BGUCN2,BGUCN3,BGUCN4,BGUCND,BGUCNDS1,BGUCNJN,BGUCNJP,BGUCNOT,BGUCONJ,BGUCQ,BGUCSBJ,BGUCSBS,BGUCSEG,BGUCSUB,BGUCTV,BGUCVAL,BGUCWRDS
K BGUCX,BGUTV(1)
Q
;
INIT ;
S U="^",BGUFILE=2
;S BGUCNDS="SEX=""M"" OR (AGE .GT. 64 AND (S>139 OR D >89) AND W<300) AND SEX .PM. 1""M"""
S BGUCNDS=".02=""M"" AND .033 .GT. 64"
;S BGUV(BGUFILE,"SEX")="M",BGUV(BGUFILE,"AGE")=65,BGUV(BGUFILE,"S")=140,BGUV(BGUFILE,"D")=89,BGUV(BGUFILE,"W")=300
;S BGUV(5,".02")="M",BGUV(BGUFILE,"AGE")=65,BGUV(BGUFILE,"S")=140,BGUV(BGUFILE,"D")=89,BGUV(BGUFILE,"W")=300
Q
;
; Input : BGUCNDS
; Output : BGUCND
BLDCND ;EP Called by BGULIST2
K BGUCND
S BGUCLV=0,BGUCMXL=0,BGUCARY="BGUCND"
S BGUCOND="LT:<,LE:<=,GT:>,GE:>=,EQ:=,NE:<>,CT:[,NC:'[,PM:?,NP:'?"
F BGUCN=1:1:$L(BGUCOND,",") S BGUCOND1=$P(BGUCOND,",",BGUCN),BGUCOND($P(BGUCOND1,":",1))=$P(BGUCOND1,":",2)
S BGUCOND="" K BGUCOND1
F BGUCN=1:1:$L(BGUCNDS,"(") S BGUCNDS1=$P(BGUCNDS,"(",BGUCN) D:BGUCNDS1'?." "
.S BGUCLV=BGUCLV+1 S:BGUCLV=1 BGUCARY=$P(BGUCARY,"(") I BGUCLV>1 S:BGUCLV=2 BGUCARY=BGUCARY_"(" S BGUCARY=$P(BGUCARY,")") S:BGUCLV>2 BGUCARY=BGUCARY_"," S BGUCARY=BGUCARY_BGUCSUB(BGUCLV-1)_")"
.S BGUCEXP=$P(BGUCNDS1,")") D BLDEXP
.I BGUCNDS1[")" F BGUCN2=2:1:$L(BGUCNDS1,")") S BGUCLV=BGUCLV-1,BGUCEXP=$P(BGUCNDS1,")",BGUCN2) I BGUCEXP'?." " S BGUCARY=$S(BGUCLV>1:$P(BGUCARY,",",1,BGUCLV-1)_")",1:$P(BGUCARY,"(")) D BLDEXP
S BGUCMXL=BGUCMXL*2
K BGUCARY,BGUCC,BGUCEXP,BGUCEXP1,BGUCLCNJ,BGUCLSEG,BGUCLV,BGUCN,BGUCN1,BGUCN2,BGUCN3,BGUCN4,BGUCNDS1,BGUCNJN,BGUCNJP,BGUCOND,BGUCSBJ,BGUCSBJL,BGUCSEG,BGUCSUB,BGUCVAL,BGUCWRDS
Q
;
BLDEXP ;
S (BGUCSEG,BGUCNJP,BGUCNJN,BGUCLCNJ)="",BGUCWRDS=$L(BGUCEXP," ")
F BGUCN3=1:1:BGUCWRDS S BGUCEXP1=$P(BGUCEXP," ",BGUCN3) D
.I " AND OR NOT "[(" "_BGUCEXP1_" ") D Q
..I BGUCSEG="" S BGUCNJP=$S(BGUCEXP1="NOT":"N"_BGUCNJP,1:BGUCEXP1) Q
..S BGUCNJN=$S(BGUCEXP1="NOT":"N"_BGUCNJN,1:BGUCEXP1)
.I BGUCNJN'="" D BLDEXP1 S (BGUCSEG,BGUCNJP,BGUCNJN)=""
.;S:BGUCN3>1 BGUCSEG=BGUCSEG_" " S BGUCSEG=BGUCSEG_BGUCEXP1
.S BGUCSEG=BGUCSEG_BGUCEXP1 S:$L(BGUCSEG,"""")#2=0 BGUCSEG=BGUCSEG_" "
D:BGUCSEG'="" BLDEXP1
Q
;
BLDEXP1 ;
S:BGUCNJP="" BGUCNJP=BGUCLCNJ
S BGUCLSEG=$L(BGUCSEG),(BGUCSBJ,BGUCND,BGUCVAL)=""
S BGUCQ=0 F BGUCN4=1:1:BGUCLSEG S BGUCC=$E(BGUCSEG,BGUCN4) D Q:BGUCQ S BGUCSBJ=BGUCSBJ_BGUCC
.Q:BGUCC?1AN Q:"!;"[BGUCC
.I BGUCC=".",$E(BGUCSEG,BGUCN4+1)?1N Q
.I BGUCC="-",$E(BGUCSEG,BGUCN4+1)="P" Q
.S BGUCQ=1
F BGUCN4=BGUCN4:1:BGUCLSEG S BGUCC=$E(BGUCSEG,BGUCN4) Q:"<>=[?"'[BGUCC S BGUCND=BGUCND_BGUCC
S:BGUCC="." BGUCND=$P($E(BGUCSEG,BGUCN4,BGUCLSEG),".",2),BGUCND=$G(BGUCOND(BGUCND)),BGUCN4=$F(BGUCSEG,".",BGUCN4+1)
S BGUCSBJL=$L(BGUCSBJ,"!") S:BGUCSBJ[";" BGUCSBJL=BGUGLEV($P(BGUCSBJ,";"),$P(BGUCSBJ,";",2))/2 S:BGUCSBJL>BGUCMXL BGUCMXL=BGUCSBJL
S BGUCVAL=$E(BGUCSEG,BGUCN4,BGUCLSEG),BGUCSEG=BGUCSBJ_"~"_BGUCND_"~"_BGUCVAL
S BGUCSUB(BGUCLV)=$O(@BGUCARY@(""),-1)+1,@BGUCARY@(BGUCSUB(BGUCLV))=BGUCNJP_U_BGUCSEG_U_BGUCNJN
S BGUCLCNJ=BGUCNJN
Q
;
; Input : BGUCND,BGUV
; Output : BGUTV
CND ;EP Called by BGULIST1
;W !,BGUCNDS,!
S BGUCARY="BGUCND",(BGUCLV,BGUCF)=1,(BGUCSUB,BGUCSBS,BGUCSKP)=""
F S BGUCSUB(BGUCLV)=$O(@BGUCARY@($G(BGUCSUB(BGUCLV)))),BGUCSUB=BGUCSUB(BGUCLV) Q:BGUCSUB=""!'BGUCF&(BGUCLV=1) D
.I BGUCSUB=""!'BGUCF S BGUCLV=BGUCLV-1,BGUCF=1 D D:$D(BGUTV(BGUCLV+1)) CKUPTV Q
..I BGUCLV=1 S BGUCARY=$P(BGUCARY,"("),BGUCSBS="" Q
..S BGUCSBS=$P(BGUCSBS,",",1,BGUCLV-1),BGUCARY=$P(BGUCARY,"(")_"("_BGUCSBS_")"
.D EVAL Q:'BGUCF
.I BGUCSKP S BGUCSKP=0 Q
.S BGUCLV=BGUCLV+1 S:BGUCLV>2 BGUCSBS=BGUCSBS_"," S BGUCSBS=BGUCSBS_BGUCSUB
.S BGUCARY=$P(BGUCARY,"(")_"("_BGUCSBS_")"
.;W !,BGUCARY,?10+(BGUCLV*5),@BGUCARY
S BGUTV=BGUTV(1)
K BGUCARY,BGUCEXP,BGUCF,BGUCLV,BGUCNJN,BGUCNJP,BGUCNOT,BGUCSBJ,BGUCSBS,BGUCSKP,BGUCSUB,BGUCTV,BGUCVAL,BGUCX,BGUTV(1)
;W ! ZW BGUV,BGUTV
Q
;
CKUPTV ;
S BGUCNJN=$P(@BGUCARY@(BGUCSUB(BGUCLV)),U,3),BGUCTV=$$CONJ(BGUCNJN,BGUTV(BGUCLV+1))
D
.I BGUCTV D Q
..I BGUCNJN'["AND" S BGUTV(BGUCLV)=1 Q
..I $G(BGUTV(BGUCLV))=0 S BGUTV(BGUCLV)=0 Q
..S BGUTV(BGUCLV)=1
.S BGUTV(BGUCLV)=0
K BGUTV(BGUCLV+1)
Q
;
EVAL ;
S BGUCX=@BGUCARY@(BGUCSUB(BGUCLV)),BGUCNJP=$P(BGUCX,U),BGUCEXP=$P(BGUCX,U,2),BGUCNJN=$P(BGUCX,U,3),BGUCSBJ=$P(BGUCEXP,"~"),BGUCND=$P(BGUCEXP,"~",2),BGUCVAL=$P(BGUCEXP,"~",3)
S BGUCFID=BGUFILE S:BGUCSBJ[";" BGUCFID=$P(BGUCSBJ,";"),BGUCSBJ=$P(BGUCSBJ,";",2) S BGUCSBJ=$G(BGUV(BGUCFID,BGUCSBJ))
D:BGUCND'["?"
.I BGUCVAL?1N.E S BGUCFID=BGUFILE S:BGUCVAL[";" BGUCFID=$P(BGUCVAL,";"),BGUCVAL=$P(BGUCVAL,";",2) S BGUCVAL=$G(BGUV(BGUCFID,BGUCVAL)) Q
.S:$E(BGUCVAL)="""" BGUCVAL=$P(BGUCVAL,"""",2)
;W !,"Subject: ",BGUCSBJ," Conditon: ",BGUCND," Value: ",BGUCVAL
D
.I BGUCND["=" D Q
..I BGUCND="=" S BGUTV=BGUCSBJ=BGUCVAL Q
..I BGUCND["<" S BGUTV=BGUCSBJ'>BGUCVAL Q
..I BGUCND[">" S BGUTV=BGUCSBJ'<BGUCVAL Q
.I BGUCND["<" D Q
..I BGUCND="<" S BGUTV=BGUCSBJ<BGUCVAL Q
..I BGUCND[">" S BGUTV=BGUCSBJ'=BGUCVAL Q
.I BGUCND=">" S BGUTV=BGUCSBJ>BGUCVAL Q
.I BGUCND["[" D Q
..I BGUCND="[" S BGUTV=BGUCSBJ[BGUCVAL Q
..S BGUTV=BGUCSBJ'[BGUCVAL Q
.I BGUCND["?" D Q
..I BGUCND="?" S BGUTV=BGUCSBJ?@BGUCVAL Q
..S BGUTV=BGUCSBJ'?@BGUCVAL Q
S BGUCTV=$S(BGUCNJP'="":$$CONJ(BGUCNJP,BGUTV),1:BGUTV)
I BGUCTV D Q
.I BGUCNJP["AND",$G(BGUTV(BGUCLV))=0 Q
.S BGUTV(BGUCLV)=1
.S:BGUCNJN["OR" BGUCSKP=1
I BGUCNJP["OR",$G(BGUTV(BGUCLV)) Q
S BGUTV(BGUCLV)=0
I BGUCNJP["AND",BGUCNJN="" S BGUCF=0
S:BGUCNJN["AND" BGUCSKP=1
Q
;
CONJ(BGUCONJ,BGUTVX) ;
S BGUCNOT=0 S:$E(BGUCONJ)="N" BGUCONJ=$E(BGUCONJ,2,4),BGUCNOT=1
Q:BGUCNOT 'BGUTVX
Q BGUTVX
BGUCND ; IHS/OIT/MJL - CONDITION HANDLER ; [ 12/01/2005 3:27 PM ]
+1 ;;1.5;BGU;**2**;MAY 26, 2005
+2 ;
+3 ; BLDCND BUILDS THE CONDITION ARRAY THAT IS USED BY CND TO SET A TRUTH
+4 ; VALUE. CALL BLDCND DURING THE CALLING APPLICATIONS INIT OR WHENEVER
+5 ; A NEW CONDITON IS NEEDED.
+6 ;
+7 ; DO INIT FIRST IF TESTING SEPARATELY
+8 ;
+9 ; USE FOR TESTING -- D INIT,BLDCND,CND
+10 DO INIT
DO BLDCND
DO CND
DO KILL
+11 QUIT
+12 ;
KILL ;EP Called by BGULIST
+1 KILL BGUCARY,BGUCC,BGUCEXP,BGUCEXP1,BGUCF,BGUCFID,BGUCLCNJ,BGUCLSEG,BGUCLV,BGUCMXL,BGUCN,BGUCN1,BGUCN2,BGUCN3,BGUCN4,BGUCND,BGUCNDS1,BGUCNJN,BGUCNJP,BGUCNOT,BGUCONJ,BGUCQ,BGUCSBJ,BGUCSBS,BGUCSEG,BGUCSUB,BGUCTV,BGUCVAL,BGUCWRDS
+2 KILL BGUCX,BGUTV(1)
+3 QUIT
+4 ;
INIT ;
+1 SET U="^"
SET BGUFILE=2
+2 ;S BGUCNDS="SEX=""M"" OR (AGE .GT. 64 AND (S>139 OR D >89) AND W<300) AND SEX .PM. 1""M"""
+3 SET BGUCNDS=".02=""M"" AND .033 .GT. 64"
+4 ;S BGUV(BGUFILE,"SEX")="M",BGUV(BGUFILE,"AGE")=65,BGUV(BGUFILE,"S")=140,BGUV(BGUFILE,"D")=89,BGUV(BGUFILE,"W")=300
+5 ;S BGUV(5,".02")="M",BGUV(BGUFILE,"AGE")=65,BGUV(BGUFILE,"S")=140,BGUV(BGUFILE,"D")=89,BGUV(BGUFILE,"W")=300
+6 QUIT
+7 ;
+8 ; Input : BGUCNDS
+9 ; Output : BGUCND
BLDCND ;EP Called by BGULIST2
+1 KILL BGUCND
+2 SET BGUCLV=0
SET BGUCMXL=0
SET BGUCARY="BGUCND"
+3 SET BGUCOND="LT:<,LE:<=,GT:>,GE:>=,EQ:=,NE:<>,CT:[,NC:'[,PM:?,NP:'?"
+4 FOR BGUCN=1:1:$LENGTH(BGUCOND,",")
SET BGUCOND1=$PIECE(BGUCOND,",",BGUCN)
SET BGUCOND($PIECE(BGUCOND1,":",1))=$PIECE(BGUCOND1,":",2)
+5 SET BGUCOND=""
KILL BGUCOND1
+6 FOR BGUCN=1:1:$LENGTH(BGUCNDS,"(")
SET BGUCNDS1=$PIECE(BGUCNDS,"(",BGUCN)
IF BGUCNDS1'?." "
Begin DoDot:1
+7 SET BGUCLV=BGUCLV+1
IF BGUCLV=1
SET BGUCARY=$PIECE(BGUCARY,"(")
IF BGUCLV>1
IF BGUCLV=2
SET BGUCARY=BGUCARY_"("
SET BGUCARY=$PIECE(BGUCARY,")")
IF BGUCLV>2
SET BGUCARY=BGUCARY_","
SET BGUCARY=BGUCARY_BGUCSUB(BGUCLV-1)_")"
+8 SET BGUCEXP=$PIECE(BGUCNDS1,")")
DO BLDEXP
+9 IF BGUCNDS1[")"
FOR BGUCN2=2:1:$LENGTH(BGUCNDS1,")")
SET BGUCLV=BGUCLV-1
SET BGUCEXP=$PIECE(BGUCNDS1,")",BGUCN2)
IF BGUCEXP'?." "
SET BGUCARY=$SELECT(BGUCLV>1:$PIECE(BGUCARY,",",1,BGUCLV-1)_")",1:$PIECE(BGUCARY,"("))
DO BLDEXP
End DoDot:1
+10 SET BGUCMXL=BGUCMXL*2
+11 KILL BGUCARY,BGUCC,BGUCEXP,BGUCEXP1,BGUCLCNJ,BGUCLSEG,BGUCLV,BGUCN,BGUCN1,BGUCN2,BGUCN3,BGUCN4,BGUCNDS1,BGUCNJN,BGUCNJP,BGUCOND,BGUCSBJ,BGUCSBJL,BGUCSEG,BGUCSUB,BGUCVAL,BGUCWRDS
+12 QUIT
+13 ;
BLDEXP ;
+1 SET (BGUCSEG,BGUCNJP,BGUCNJN,BGUCLCNJ)=""
SET BGUCWRDS=$LENGTH(BGUCEXP," ")
+2 FOR BGUCN3=1:1:BGUCWRDS
SET BGUCEXP1=$PIECE(BGUCEXP," ",BGUCN3)
Begin DoDot:1
+3 IF " AND OR NOT "[(" "_BGUCEXP1_" ")
Begin DoDot:2
+4 IF BGUCSEG=""
SET BGUCNJP=$SELECT(BGUCEXP1="NOT":"N"_BGUCNJP,1:BGUCEXP1)
QUIT
+5 SET BGUCNJN=$SELECT(BGUCEXP1="NOT":"N"_BGUCNJN,1:BGUCEXP1)
End DoDot:2
QUIT
+6 IF BGUCNJN'=""
DO BLDEXP1
SET (BGUCSEG,BGUCNJP,BGUCNJN)=""
+7 ;S:BGUCN3>1 BGUCSEG=BGUCSEG_" " S BGUCSEG=BGUCSEG_BGUCEXP1
+8 SET BGUCSEG=BGUCSEG_BGUCEXP1
IF $LENGTH(BGUCSEG,"""")#2=0
SET BGUCSEG=BGUCSEG_" "
End DoDot:1
+9 IF BGUCSEG'=""
DO BLDEXP1
+10 QUIT
+11 ;
BLDEXP1 ;
+1 IF BGUCNJP=""
SET BGUCNJP=BGUCLCNJ
+2 SET BGUCLSEG=$LENGTH(BGUCSEG)
SET (BGUCSBJ,BGUCND,BGUCVAL)=""
+3 SET BGUCQ=0
FOR BGUCN4=1:1:BGUCLSEG
SET BGUCC=$EXTRACT(BGUCSEG,BGUCN4)
Begin DoDot:1
+4 IF BGUCC?1AN
QUIT
IF "!;"[BGUCC
QUIT
+5 IF BGUCC="."
IF $EXTRACT(BGUCSEG,BGUCN4+1)?1N
QUIT
+6 IF BGUCC="-"
IF $EXTRACT(BGUCSEG,BGUCN4+1)="P"
QUIT
+7 SET BGUCQ=1
End DoDot:1
IF BGUCQ
QUIT
SET BGUCSBJ=BGUCSBJ_BGUCC
+8 FOR BGUCN4=BGUCN4:1:BGUCLSEG
SET BGUCC=$EXTRACT(BGUCSEG,BGUCN4)
IF "<>=[?"'[BGUCC
QUIT
SET BGUCND=BGUCND_BGUCC
+9 IF BGUCC="."
SET BGUCND=$PIECE($EXTRACT(BGUCSEG,BGUCN4,BGUCLSEG),".",2)
SET BGUCND=$GET(BGUCOND(BGUCND))
SET BGUCN4=$FIND(BGUCSEG,".",BGUCN4+1)
+10 SET BGUCSBJL=$LENGTH(BGUCSBJ,"!")
IF BGUCSBJ[";"
SET BGUCSBJL=BGUGLEV($PIECE(BGUCSBJ,";"),$PIECE(BGUCSBJ,";",2))/2
IF BGUCSBJL>BGUCMXL
SET BGUCMXL=BGUCSBJL
+11 SET BGUCVAL=$EXTRACT(BGUCSEG,BGUCN4,BGUCLSEG)
SET BGUCSEG=BGUCSBJ_"~"_BGUCND_"~"_BGUCVAL
+12 SET BGUCSUB(BGUCLV)=$ORDER(@BGUCARY@(""),-1)+1
SET @BGUCARY@(BGUCSUB(BGUCLV))=BGUCNJP_U_BGUCSEG_U_BGUCNJN
+13 SET BGUCLCNJ=BGUCNJN
+14 QUIT
+15 ;
+16 ; Input : BGUCND,BGUV
+17 ; Output : BGUTV
CND ;EP Called by BGULIST1
+1 ;W !,BGUCNDS,!
+2 SET BGUCARY="BGUCND"
SET (BGUCLV,BGUCF)=1
SET (BGUCSUB,BGUCSBS,BGUCSKP)=""
+3 FOR
SET BGUCSUB(BGUCLV)=$ORDER(@BGUCARY@($GET(BGUCSUB(BGUCLV))))
SET BGUCSUB=BGUCSUB(BGUCLV)
IF BGUCSUB=""!'BGUCF&(BGUCLV=1)
QUIT
Begin DoDot:1
+4 IF BGUCSUB=""!'BGUCF
SET BGUCLV=BGUCLV-1
SET BGUCF=1
Begin DoDot:2
+5 IF BGUCLV=1
SET BGUCARY=$PIECE(BGUCARY,"(")
SET BGUCSBS=""
QUIT
+6 SET BGUCSBS=$PIECE(BGUCSBS,",",1,BGUCLV-1)
SET BGUCARY=$PIECE(BGUCARY,"(")_"("_BGUCSBS_")"
End DoDot:2
IF $DATA(BGUTV(BGUCLV+1))
DO CKUPTV
QUIT
+7 DO EVAL
IF 'BGUCF
QUIT
+8 IF BGUCSKP
SET BGUCSKP=0
QUIT
+9 SET BGUCLV=BGUCLV+1
IF BGUCLV>2
SET BGUCSBS=BGUCSBS_","
SET BGUCSBS=BGUCSBS_BGUCSUB
+10 SET BGUCARY=$PIECE(BGUCARY,"(")_"("_BGUCSBS_")"
+11 ;W !,BGUCARY,?10+(BGUCLV*5),@BGUCARY
End DoDot:1
+12 SET BGUTV=BGUTV(1)
+13 KILL BGUCARY,BGUCEXP,BGUCF,BGUCLV,BGUCNJN,BGUCNJP,BGUCNOT,BGUCSBJ,BGUCSBS,BGUCSKP,BGUCSUB,BGUCTV,BGUCVAL,BGUCX,BGUTV(1)
+14 ;W ! ZW BGUV,BGUTV
+15 QUIT
+16 ;
CKUPTV ;
+1 SET BGUCNJN=$PIECE(@BGUCARY@(BGUCSUB(BGUCLV)),U,3)
SET BGUCTV=$$CONJ(BGUCNJN,BGUTV(BGUCLV+1))
+2 Begin DoDot:1
+3 IF BGUCTV
Begin DoDot:2
+4 IF BGUCNJN'["AND"
SET BGUTV(BGUCLV)=1
QUIT
+5 IF $GET(BGUTV(BGUCLV))=0
SET BGUTV(BGUCLV)=0
QUIT
+6 SET BGUTV(BGUCLV)=1
End DoDot:2
QUIT
+7 SET BGUTV(BGUCLV)=0
End DoDot:1
+8 KILL BGUTV(BGUCLV+1)
+9 QUIT
+10 ;
EVAL ;
+1 SET BGUCX=@BGUCARY@(BGUCSUB(BGUCLV))
SET BGUCNJP=$PIECE(BGUCX,U)
SET BGUCEXP=$PIECE(BGUCX,U,2)
SET BGUCNJN=$PIECE(BGUCX,U,3)
SET BGUCSBJ=$PIECE(BGUCEXP,"~")
SET BGUCND=$PIECE(BGUCEXP,"~",2)
SET BGUCVAL=$PIECE(BGUCEXP,"~",3)
+2 SET BGUCFID=BGUFILE
IF BGUCSBJ[";"
SET BGUCFID=$PIECE(BGUCSBJ,";")
SET BGUCSBJ=$PIECE(BGUCSBJ,";",2)
SET BGUCSBJ=$GET(BGUV(BGUCFID,BGUCSBJ))
+3 IF BGUCND'["?"
Begin DoDot:1
+4 IF BGUCVAL?1N.E
SET BGUCFID=BGUFILE
IF BGUCVAL[";"
SET BGUCFID=$PIECE(BGUCVAL,";")
SET BGUCVAL=$PIECE(BGUCVAL,";",2)
SET BGUCVAL=$GET(BGUV(BGUCFID,BGUCVAL))
QUIT
+5 IF $EXTRACT(BGUCVAL)=""""
SET BGUCVAL=$PIECE(BGUCVAL,"""",2)
End DoDot:1
+6 ;W !,"Subject: ",BGUCSBJ," Conditon: ",BGUCND," Value: ",BGUCVAL
+7 Begin DoDot:1
+8 IF BGUCND["="
Begin DoDot:2
+9 IF BGUCND="="
SET BGUTV=BGUCSBJ=BGUCVAL
QUIT
+10 IF BGUCND["<"
SET BGUTV=BGUCSBJ'>BGUCVAL
QUIT
+11 IF BGUCND[">"
SET BGUTV=BGUCSBJ'<BGUCVAL
QUIT
End DoDot:2
QUIT
+12 IF BGUCND["<"
Begin DoDot:2
+13 IF BGUCND="<"
SET BGUTV=BGUCSBJ<BGUCVAL
QUIT
+14 IF BGUCND[">"
SET BGUTV=BGUCSBJ'=BGUCVAL
QUIT
End DoDot:2
QUIT
+15 IF BGUCND=">"
SET BGUTV=BGUCSBJ>BGUCVAL
QUIT
+16 IF BGUCND["["
Begin DoDot:2
+17 IF BGUCND="["
SET BGUTV=BGUCSBJ[BGUCVAL
QUIT
+18 SET BGUTV=BGUCSBJ'[BGUCVAL
QUIT
End DoDot:2
QUIT
+19 IF BGUCND["?"
Begin DoDot:2
+20 IF BGUCND="?"
SET BGUTV=BGUCSBJ?@BGUCVAL
QUIT
+21 SET BGUTV=BGUCSBJ'?@BGUCVAL
QUIT
End DoDot:2
QUIT
End DoDot:1
+22 SET BGUCTV=$SELECT(BGUCNJP'="":$$CONJ(BGUCNJP,BGUTV),1:BGUTV)
+23 IF BGUCTV
Begin DoDot:1
+24 IF BGUCNJP["AND"
IF $GET(BGUTV(BGUCLV))=0
QUIT
+25 SET BGUTV(BGUCLV)=1
+26 IF BGUCNJN["OR"
SET BGUCSKP=1
End DoDot:1
QUIT
+27 IF BGUCNJP["OR"
IF $GET(BGUTV(BGUCLV))
QUIT
+28 SET BGUTV(BGUCLV)=0
+29 IF BGUCNJP["AND"
IF BGUCNJN=""
SET BGUCF=0
+30 IF BGUCNJN["AND"
SET BGUCSKP=1
+31 QUIT
+32 ;
CONJ(BGUCONJ,BGUTVX) ;
+1 SET BGUCNOT=0
IF $EXTRACT(BGUCONJ)="N"
SET BGUCONJ=$EXTRACT(BGUCONJ,2,4)
SET BGUCNOT=1
+2 IF BGUCNOT
QUIT 'BGUTVX
+3 QUIT BGUTVX