- 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
