BQIDCAH5 ;GDIT/HS/ALA-Ad Hoc Logic Continued ; 18 Jan 2013 6:42 AM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
DOB(FGLOB,TGLOB,DBFROM,DBTHRU) ;EP - Date of Birth search
I $G(TGLOB)="" Q
I $G(DBFROM)="" Q
;
NEW IEN,PDOB
S IEN=0
I $G(FGLOB)'="" D
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D
.. S PDOB=$P($G(^DPT(IEN,0)),U,3) I PDOB="" Q
.. I PDOB<DBFROM!(PDOB>DBTHRU) Q
.. S @TGLOB@(IEN)=""
;
I $G(FGLOB)="" D
. NEW FDT,TDT
. S FDT=DBFROM-.001,TDT=DBTHRU F S FDT=$O(^DPT("ADOB",FDT)) Q:FDT=""!(FDT>TDT) D
.. S IEN="" F S IEN=$O(^DPT("ADOB",FDT,IEN)) Q:'IEN S @TGLOB@(IEN)=""
Q
;
GEN(FGLOB,TGLOB,GEN) ;EP - Gender search
I $G(TGLOB)="" Q
I $G(GEN)="" Q
;
NEW IEN
S IEN=0
I $G(FGLOB)'="" D
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D GCHK
;
I $G(FGLOB)="" D
. F S IEN=$O(^AUPNPAT(IEN)) Q:'IEN D GCHK
Q
;
GCHK ;EP Gender check
I $P($G(^DPT(IEN,0)),U,2)'=GEN Q
S @TGLOB@(IEN)=""
Q
;
PCOMM(FGLOB,TGLOB,PCOMM) ;EP - Preferred Communication search
I $G(TGLOB)="" Q
I $G(PCOMM)="" Q
;
NEW IEN
S IEN=0
I $G(FGLOB)'="" D
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D PCHK
;
I $G(FGLOB)="" D
. F S IEN=$O(^AUPNPAT(IEN)) Q:'IEN D PCHK
Q
;
PCHK ;EP
I $P($G(^AUPNPAT(IEN,40)),U,2)'=PCOMM Q
S @TGLOB@(IEN)=""
Q
;
RACE(FGLOB,TGLOB,RACE,MPARMS) ;EP - Race search
NEW RCN
I $G(TGLOB)="" Q
I $G(RACE)]"" S RCN=$G(RACE) D RCE
I $D(MPARMS("RACE")) S RCN="" F S RCN=$O(MPARMS("RACE",RCN)) Q:RCN="" D RCE
Q
;
RCE ;EP
NEW IEN
I $G(FGLOB)'="" D
. S IEN=""
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D RCHK
;
I $G(FGLOB)="" D
. S IEN=0
. F S IEN=$O(^AUPNPAT(IEN)) Q:'IEN D RCHK
Q
;
RCHK ;EP
;I $G(RCN)?.N S RACE=$P(^DIC(10,RCN,0),U,1)
;I $P($$RCE^BQIPTDMG(IEN,.01),$C(28),2)'=RACE Q
I $D(^DPT(IEN,.02,RCN)) S @TGLOB@(IEN)=""
Q
;
ETHN(FGLOB,TGLOB,ETHN,MPARMS) ;EP - Ethnicity search
NEW EN
I $G(TGLOB)="" Q
I $G(ETHN)]"" S EN=$G(ETHN) D ETH
I $D(MPARMS("ETHN")) S EN="" F S EN=$O(MPARMS("ETHN",EN)) Q:EN="" D ETH
Q
;
ETH ;EP
NEW IEN
S IEN=0
I $G(FGLOB)'="" D
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D ECHK
;
I $G(FGLOB)="" D
. F S IEN=$O(^AUPNPAT(IEN)) Q:'IEN D ECHK
Q
;
ECHK ;EP
;I EN?.N S ETHN=$P(^DIC(10.2,EN,0),U,1)
;I $P($$ETHN^BQIPTDMG(IEN,.01),$C(28),2)'=ETHN Q
I $D(^DPT(IEN,.06,EN)) S @TGLOB@(IEN)=""
Q
;
PLANG(FGLOB,TGLOB,PLANG) ;EP - Preferred Language search
I $G(TGLOB)="" Q
I $G(PLANG)="" Q
;
NEW IEN
S IEN=0
I $G(FGLOB)'="" D
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D LCHK
;
I $G(FGLOB)="" D
. F S IEN=$O(^AUPNPAT(IEN)) Q:'IEN D LCHK
Q
;
LCHK ;EP
I PLANG?.N S PLANG=$P(^AUTTLANG(PLANG,0),U,1)
I $$PFLNG^BQIULPT(IEN)'=PLANG Q
S @TGLOB@(IEN)=""
Q
;
EDU(FGLOB,TGLOB,EDUC,EDUTX,FDT,TDT,EDUNOT,MPARMS) ;EP - Education search
NEW EDPT,TREF,ETAX,NGLOB,LN,RET,TOPN,TOP
S NGLOB=$NA(^TMP("BQIDCEDUC",$J)) K @NGLOB
I $G(TGLOB)="" Q
I $G(EDUC)'="" D ED
I $G(EDUTX)'="" D
. S TREF=$NA(MPARMS("EDUC"))
. K @TREF
. S ETAX=$P(@("^"_$P(EDUTX,";",2)_$P(EDUTX,";",1)_",0)"),"^",1)
. D BLD^BQITUTL(ETAX,TREF)
I $G(EDUTOP)'="" D
. S TOPN=EDUTOP,TOP=$P(^AUTTEDMT(TOPN,0),U,2)
. S LN=0
. F S LN=$O(^AUTTEDT(LN)) Q:'LN D
.. S RET=$G(^AUTTEDT(LN,0))
.. I RET="" Q
.. I $P(RET,U,3)'="" Q
.. I $P(RET,U,6)'=TOP Q
.. S MPARMS("EDUC",LN)=""
I $G(EDUPICK)'="" D
. S LN=0
. F S LN=$O(^BGOEDTPR(EDUPICK,1,"B",LN)) Q:LN="" D
.. S RET=$G(^AUTTEDT(LN,0))
.. I RET="" Q
.. I $P(RET,U,3)'="" Q
.. S MPARMS("EDUC",LN)=""
;
I EDUOP="!" D
. I $D(MPARMS("EDUC")) S EDUC="" F S EDUC=$O(MPARMS("EDUC",EDUC)) Q:EDUC="" D ED
I EDUOP="&" D
. K EDPT
. S EDUC="",CT=0 F S EDUC=$O(MPARMS("EDUC",EDUC)) Q:EDUC="" D ED S CT=CT+1
. S IEN=""
. F S IEN=$O(EDPT(IEN)) Q:IEN="" D
.. S MCT=0,ED=""
.. F S ED=$O(EDPT(IEN,ED)) Q:ED="" S MCT=MCT+1
.. I MCT=CT,'EDUNOT S @TGLOB@(IEN)="",MIEN=EDPT(IEN,ED),@CRIT@("EDUC",IEN,MIEN)="" Q
.. I MCT=CT,EDUNOT S @NGLOB@(IEN)="" K @CRIT@("EDUC",IEN)
;
I EDUNOT,$G(FGLOB)'="" D
. S IEN="" F S IEN=$O(@FGLOB@(IEN)) Q:IEN="" D
.. I '$D(@NGLOB@(IEN)) S @TGLOB@(IEN)=""
I EDUNOT,$G(FGLOB)="" D
. S IEN=0 F S IEN=$O(^AUPNPAT(IEN)) Q:'IEN I '$D(@NGLOB@(IEN)) S @TGLOB@(IEN)=""
K @NGLOB
Q
;
ED ;EP
NEW DFN,IEN
S TDT=$S(TDT'="":TDT,1:DT)
I $G(FGLOB)'="" D Q
. NEW IEN,EDP
. S IEN=""
. F S IEN=$O(@FGLOB@(IEN)) Q:'IEN D
.. I FDT="" D
... S BDT=""
... F S BDT=$O(^AUPNVPED("AA",IEN,BDT)) Q:BDT="" D EDDT
.. I FDT'="" D
... S BGT=9999999-FDT,ENT=9999999-TDT,BDT=ENT-1
... F S BDT=$O(^AUPNVPED("AA",IEN,BDT)) Q:BDT=""!(BDT>BGT) D EDDT
;
S IEN=""
F S IEN=$O(^AUPNVPED("B",EDUC,IEN)) Q:IEN="" D
. I $G(^AUPNVPED(IEN,0))="" Q
. S DFN=$P(^AUPNVPED(IEN,0),U,2),VIS=$P(^AUPNVPED(IEN,0),U,3) I VIS="" Q
. I $G(^AUPNVSIT(VIS,0))="" Q
. Q:"DXCTI"[$P(^AUPNVSIT(VIS,0),U,7)
. S VSDTM=$P(^AUPNVSIT(VIS,0),U,1)\1
. I FDT'="",VSDTM<FDT!(VSDTM>TDT) Q
. I DFN'="",EDUOP="!",EDUNOT S @NGLOB@(DFN)="" Q
. I DFN'="",EDUOP="!",'EDUNOT S @TGLOB@(DFN)="",@CRIT@("EDUC",DFN,IEN)="" Q
. I DFN'="",EDUOP="&" S EDPT(DFN,EDUC)=IEN
Q
;
EDDT ;EP
S MIEN=""
F S MIEN=$O(^AUPNVPED("AA",IEN,BDT,MIEN)) Q:MIEN="" D
. S EDP=$P($G(^AUPNVPED(MIEN,0)),U,1)
. I EDUOP="!",EDP=EDUC,EDUNOT S @NGLOB@(IEN)="" Q
. I EDUOP="!",EDP=EDUC,'EDUNOT S @TGLOB@(IEN)="",@CRIT@("EDUC",IEN,MIEN)="" Q
. I EDUOP="&",EDP=EDUC S EDPT(IEN,EDUC)=MIEN
Q
BQIDCAH5 ;GDIT/HS/ALA-Ad Hoc Logic Continued ; 18 Jan 2013 6:42 AM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
DOB(FGLOB,TGLOB,DBFROM,DBTHRU) ;EP - Date of Birth search
+1 IF $GET(TGLOB)=""
QUIT
+2 IF $GET(DBFROM)=""
QUIT
+3 ;
+4 NEW IEN,PDOB
+5 SET IEN=0
+6 IF $GET(FGLOB)'=""
Begin DoDot:1
+7 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
Begin DoDot:2
+8 SET PDOB=$PIECE($GET(^DPT(IEN,0)),U,3)
IF PDOB=""
QUIT
+9 IF PDOB<DBFROM!(PDOB>DBTHRU)
QUIT
+10 SET @TGLOB@(IEN)=""
End DoDot:2
End DoDot:1
+11 ;
+12 IF $GET(FGLOB)=""
Begin DoDot:1
+13 NEW FDT,TDT
+14 SET FDT=DBFROM-.001
SET TDT=DBTHRU
FOR
SET FDT=$ORDER(^DPT("ADOB",FDT))
IF FDT=""!(FDT>TDT)
QUIT
Begin DoDot:2
+15 SET IEN=""
FOR
SET IEN=$ORDER(^DPT("ADOB",FDT,IEN))
IF 'IEN
QUIT
SET @TGLOB@(IEN)=""
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
GEN(FGLOB,TGLOB,GEN) ;EP - Gender search
+1 IF $GET(TGLOB)=""
QUIT
+2 IF $GET(GEN)=""
QUIT
+3 ;
+4 NEW IEN
+5 SET IEN=0
+6 IF $GET(FGLOB)'=""
Begin DoDot:1
+7 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
DO GCHK
End DoDot:1
+8 ;
+9 IF $GET(FGLOB)=""
Begin DoDot:1
+10 FOR
SET IEN=$ORDER(^AUPNPAT(IEN))
IF 'IEN
QUIT
DO GCHK
End DoDot:1
+11 QUIT
+12 ;
GCHK ;EP Gender check
+1 IF $PIECE($GET(^DPT(IEN,0)),U,2)'=GEN
QUIT
+2 SET @TGLOB@(IEN)=""
+3 QUIT
+4 ;
PCOMM(FGLOB,TGLOB,PCOMM) ;EP - Preferred Communication search
+1 IF $GET(TGLOB)=""
QUIT
+2 IF $GET(PCOMM)=""
QUIT
+3 ;
+4 NEW IEN
+5 SET IEN=0
+6 IF $GET(FGLOB)'=""
Begin DoDot:1
+7 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
DO PCHK
End DoDot:1
+8 ;
+9 IF $GET(FGLOB)=""
Begin DoDot:1
+10 FOR
SET IEN=$ORDER(^AUPNPAT(IEN))
IF 'IEN
QUIT
DO PCHK
End DoDot:1
+11 QUIT
+12 ;
PCHK ;EP
+1 IF $PIECE($GET(^AUPNPAT(IEN,40)),U,2)'=PCOMM
QUIT
+2 SET @TGLOB@(IEN)=""
+3 QUIT
+4 ;
RACE(FGLOB,TGLOB,RACE,MPARMS) ;EP - Race search
+1 NEW RCN
+2 IF $GET(TGLOB)=""
QUIT
+3 IF $GET(RACE)]""
SET RCN=$GET(RACE)
DO RCE
+4 IF $DATA(MPARMS("RACE"))
SET RCN=""
FOR
SET RCN=$ORDER(MPARMS("RACE",RCN))
IF RCN=""
QUIT
DO RCE
+5 QUIT
+6 ;
RCE ;EP
+1 NEW IEN
+2 IF $GET(FGLOB)'=""
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
DO RCHK
End DoDot:1
+5 ;
+6 IF $GET(FGLOB)=""
Begin DoDot:1
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(^AUPNPAT(IEN))
IF 'IEN
QUIT
DO RCHK
End DoDot:1
+9 QUIT
+10 ;
RCHK ;EP
+1 ;I $G(RCN)?.N S RACE=$P(^DIC(10,RCN,0),U,1)
+2 ;I $P($$RCE^BQIPTDMG(IEN,.01),$C(28),2)'=RACE Q
+3 IF $DATA(^DPT(IEN,.02,RCN))
SET @TGLOB@(IEN)=""
+4 QUIT
+5 ;
ETHN(FGLOB,TGLOB,ETHN,MPARMS) ;EP - Ethnicity search
+1 NEW EN
+2 IF $GET(TGLOB)=""
QUIT
+3 IF $GET(ETHN)]""
SET EN=$GET(ETHN)
DO ETH
+4 IF $DATA(MPARMS("ETHN"))
SET EN=""
FOR
SET EN=$ORDER(MPARMS("ETHN",EN))
IF EN=""
QUIT
DO ETH
+5 QUIT
+6 ;
ETH ;EP
+1 NEW IEN
+2 SET IEN=0
+3 IF $GET(FGLOB)'=""
Begin DoDot:1
+4 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
DO ECHK
End DoDot:1
+5 ;
+6 IF $GET(FGLOB)=""
Begin DoDot:1
+7 FOR
SET IEN=$ORDER(^AUPNPAT(IEN))
IF 'IEN
QUIT
DO ECHK
End DoDot:1
+8 QUIT
+9 ;
ECHK ;EP
+1 ;I EN?.N S ETHN=$P(^DIC(10.2,EN,0),U,1)
+2 ;I $P($$ETHN^BQIPTDMG(IEN,.01),$C(28),2)'=ETHN Q
+3 IF $DATA(^DPT(IEN,.06,EN))
SET @TGLOB@(IEN)=""
+4 QUIT
+5 ;
PLANG(FGLOB,TGLOB,PLANG) ;EP - Preferred Language search
+1 IF $GET(TGLOB)=""
QUIT
+2 IF $GET(PLANG)=""
QUIT
+3 ;
+4 NEW IEN
+5 SET IEN=0
+6 IF $GET(FGLOB)'=""
Begin DoDot:1
+7 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
DO LCHK
End DoDot:1
+8 ;
+9 IF $GET(FGLOB)=""
Begin DoDot:1
+10 FOR
SET IEN=$ORDER(^AUPNPAT(IEN))
IF 'IEN
QUIT
DO LCHK
End DoDot:1
+11 QUIT
+12 ;
LCHK ;EP
+1 IF PLANG?.N
SET PLANG=$PIECE(^AUTTLANG(PLANG,0),U,1)
+2 IF $$PFLNG^BQIULPT(IEN)'=PLANG
QUIT
+3 SET @TGLOB@(IEN)=""
+4 QUIT
+5 ;
EDU(FGLOB,TGLOB,EDUC,EDUTX,FDT,TDT,EDUNOT,MPARMS) ;EP - Education search
+1 NEW EDPT,TREF,ETAX,NGLOB,LN,RET,TOPN,TOP
+2 SET NGLOB=$NAME(^TMP("BQIDCEDUC",$JOB))
KILL @NGLOB
+3 IF $GET(TGLOB)=""
QUIT
+4 IF $GET(EDUC)'=""
DO ED
+5 IF $GET(EDUTX)'=""
Begin DoDot:1
+6 SET TREF=$NAME(MPARMS("EDUC"))
+7 KILL @TREF
+8 SET ETAX=$PIECE(@("^"_$PIECE(EDUTX,";",2)_$PIECE(EDUTX,";",1)_",0)"),"^",1)
+9 DO BLD^BQITUTL(ETAX,TREF)
End DoDot:1
+10 IF $GET(EDUTOP)'=""
Begin DoDot:1
+11 SET TOPN=EDUTOP
SET TOP=$PIECE(^AUTTEDMT(TOPN,0),U,2)
+12 SET LN=0
+13 FOR
SET LN=$ORDER(^AUTTEDT(LN))
IF 'LN
QUIT
Begin DoDot:2
+14 SET RET=$GET(^AUTTEDT(LN,0))
+15 IF RET=""
QUIT
+16 IF $PIECE(RET,U,3)'=""
QUIT
+17 IF $PIECE(RET,U,6)'=TOP
QUIT
+18 SET MPARMS("EDUC",LN)=""
End DoDot:2
End DoDot:1
+19 IF $GET(EDUPICK)'=""
Begin DoDot:1
+20 SET LN=0
+21 FOR
SET LN=$ORDER(^BGOEDTPR(EDUPICK,1,"B",LN))
IF LN=""
QUIT
Begin DoDot:2
+22 SET RET=$GET(^AUTTEDT(LN,0))
+23 IF RET=""
QUIT
+24 IF $PIECE(RET,U,3)'=""
QUIT
+25 SET MPARMS("EDUC",LN)=""
End DoDot:2
End DoDot:1
+26 ;
+27 IF EDUOP="!"
Begin DoDot:1
+28 IF $DATA(MPARMS("EDUC"))
SET EDUC=""
FOR
SET EDUC=$ORDER(MPARMS("EDUC",EDUC))
IF EDUC=""
QUIT
DO ED
End DoDot:1
+29 IF EDUOP="&"
Begin DoDot:1
+30 KILL EDPT
+31 SET EDUC=""
SET CT=0
FOR
SET EDUC=$ORDER(MPARMS("EDUC",EDUC))
IF EDUC=""
QUIT
DO ED
SET CT=CT+1
+32 SET IEN=""
+33 FOR
SET IEN=$ORDER(EDPT(IEN))
IF IEN=""
QUIT
Begin DoDot:2
+34 SET MCT=0
SET ED=""
+35 FOR
SET ED=$ORDER(EDPT(IEN,ED))
IF ED=""
QUIT
SET MCT=MCT+1
+36 IF MCT=CT
IF 'EDUNOT
SET @TGLOB@(IEN)=""
SET MIEN=EDPT(IEN,ED)
SET @CRIT@("EDUC",IEN,MIEN)=""
QUIT
+37 IF MCT=CT
IF EDUNOT
SET @NGLOB@(IEN)=""
KILL @CRIT@("EDUC",IEN)
End DoDot:2
End DoDot:1
+38 ;
+39 IF EDUNOT
IF $GET(FGLOB)'=""
Begin DoDot:1
+40 SET IEN=""
FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF IEN=""
QUIT
Begin DoDot:2
+41 IF '$DATA(@NGLOB@(IEN))
SET @TGLOB@(IEN)=""
End DoDot:2
End DoDot:1
+42 IF EDUNOT
IF $GET(FGLOB)=""
Begin DoDot:1
+43 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNPAT(IEN))
IF 'IEN
QUIT
IF '$DATA(@NGLOB@(IEN))
SET @TGLOB@(IEN)=""
End DoDot:1
+44 KILL @NGLOB
+45 QUIT
+46 ;
ED ;EP
+1 NEW DFN,IEN
+2 SET TDT=$SELECT(TDT'="":TDT,1:DT)
+3 IF $GET(FGLOB)'=""
Begin DoDot:1
+4 NEW IEN,EDP
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(@FGLOB@(IEN))
IF 'IEN
QUIT
Begin DoDot:2
+7 IF FDT=""
Begin DoDot:3
+8 SET BDT=""
+9 FOR
SET BDT=$ORDER(^AUPNVPED("AA",IEN,BDT))
IF BDT=""
QUIT
DO EDDT
End DoDot:3
+10 IF FDT'=""
Begin DoDot:3
+11 SET BGT=9999999-FDT
SET ENT=9999999-TDT
SET BDT=ENT-1
+12 FOR
SET BDT=$ORDER(^AUPNVPED("AA",IEN,BDT))
IF BDT=""!(BDT>BGT)
QUIT
DO EDDT
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+13 ;
+14 SET IEN=""
+15 FOR
SET IEN=$ORDER(^AUPNVPED("B",EDUC,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+16 IF $GET(^AUPNVPED(IEN,0))=""
QUIT
+17 SET DFN=$PIECE(^AUPNVPED(IEN,0),U,2)
SET VIS=$PIECE(^AUPNVPED(IEN,0),U,3)
IF VIS=""
QUIT
+18 IF $GET(^AUPNVSIT(VIS,0))=""
QUIT
+19 IF "DXCTI"[$PIECE(^AUPNVSIT(VIS,0),U,7)
QUIT
+20 SET VSDTM=$PIECE(^AUPNVSIT(VIS,0),U,1)\1
+21 IF FDT'=""
IF VSDTM<FDT!(VSDTM>TDT)
QUIT
+22 IF DFN'=""
IF EDUOP="!"
IF EDUNOT
SET @NGLOB@(DFN)=""
QUIT
+23 IF DFN'=""
IF EDUOP="!"
IF 'EDUNOT
SET @TGLOB@(DFN)=""
SET @CRIT@("EDUC",DFN,IEN)=""
QUIT
+24 IF DFN'=""
IF EDUOP="&"
SET EDPT(DFN,EDUC)=IEN
End DoDot:1
+25 QUIT
+26 ;
EDDT ;EP
+1 SET MIEN=""
+2 FOR
SET MIEN=$ORDER(^AUPNVPED("AA",IEN,BDT,MIEN))
IF MIEN=""
QUIT
Begin DoDot:1
+3 SET EDP=$PIECE($GET(^AUPNVPED(MIEN,0)),U,1)
+4 IF EDUOP="!"
IF EDP=EDUC
IF EDUNOT
SET @NGLOB@(IEN)=""
QUIT
+5 IF EDUOP="!"
IF EDP=EDUC
IF 'EDUNOT
SET @TGLOB@(IEN)=""
SET @CRIT@("EDUC",IEN,MIEN)=""
QUIT
+6 IF EDUOP="&"
IF EDP=EDUC
SET EDPT(IEN,EDUC)=MIEN
End DoDot:1
+7 QUIT
