OCXOED14 ;SLC/RJS,CLA - Rule Editor (Meta Dictionary Link Options) ;10/29/98 12:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
;
S ;
;
Q
EN(OCXD0,OCXRD,OCXACT) ;
;
;
N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
;
S OCXTNLN=$C(27,91,48,109),OCXTRLN=$C(27,91,55,109),OCXTULN=$C(27,91,52,109),OCXTHLN=$C(27,91,49,109)
;
S OCXOPT=$$GETOPT^OCXOEDT(.OCXACT) Q:(OCXOPT=U) 1 X:$L(OCXOPT) OCXOPT
;
Q:'$D(^OCXS(863.3,OCXD0)) 1
;
Q 0
;
EDATT(OCXD0) ;
;
N OCXX
S OCXX=$$MDIE("^OCXS(863.3,",OCXD0,".05")
Q
;
EDPARAM(OCXD0,PARNAM) ;
;
N NEWVAL,OLDVAL
S OLDVAL=$$GLPVAL(OCXD0,PARNAM)
W !!
W " ",$$FIELD("Link Parameter -> "_PARNAM_": ")
W !!,"-> " W:$L(OLDVAL) OLDVAL_" // "
W !,"-> "
R NEWVAL:DTIME E Q
I '$L(NEWVAL) S NEWVAL=$$SCREEN^OCXOED12(OLDVAL) D:'(NEWVAL=OLDVAL) SLPVAL(OCXD0,PARNAM,NEWVAL) Q
I (NEWVAL="@") W ! Q:'$$READ("Y","Are you sure you want to delete this value ?","YES")
S:(NEWVAL["|") NEWVAL=$$SCREEN^OCXOED12(NEWVAL) D SLPVAL(OCXD0,PARNAM,NEWVAL)
Q
;
EDPATT(OCXD0,PNAME) ;
;
N OLDVAL,NEWVAL,OCXX,OCXY,OCXZ,DA,OCXPR
;
S OLDVAL="",OCXX="" F S OCXX=$O(OCXRD("ATT",OCXD0,"PAR",OCXX)) Q:'OCXX I ($G(OCXRD("ATT",OCXD0,"PAR",OCXX,.01,"E"))=PNAME) Q
S:OCXX OLDVAL=$G(OCXRD("ATT",OCXD0,"PAR",OCXX,1,"E"))
;
W !!
S OCXPR=$$FIELD("Attribute Parameter -> "_PNAME_": ") S:$L(OLDVAL) OCXPR=OCXPR_OLDVAL_" // "
S NEWVAL=$$DIC("^OCXS(864.1,","AEMQ",OCXPR)
;
S:'$D(^OCXS(863.4,OCXD0,"PAR",0)) ^OCXS(863.4,OCXD0,"PAR",0)="^863.41PI^^"
S DA(1)=OCXD0,OCXY=+$$DIC("^OCXS(863.4,"_OCXD0_",""PAR"",","ML","",PNAME,"","",.DA) Q:(OCXY<1)
S DA(1)=OCXD0,DA=+OCXY,OCXZ=$$DIE("^OCXS(863.4,"_OCXD0_",""PAR"",",.DA,1,$P(NEWVAL,U,2))
Q
;
GLPVAL(OCXD0,PNAME) ;
N X S X="" F S X=$O(OCXRD("LINK",OCXD0,"PAR",X)) Q:'X I ($G(OCXRD("LINK",OCXD0,"PAR",X,.01,"E"))=PNAME) Q
Q:'X "" Q $G(OCXRD("LINK",OCXD0,"PAR",X,1,"E"))
;
SLPVAL(OCXD0,PNAME,PVAL) ;
N DA,OCXY,OCXZ
S:'$D(^OCXS(863.4,OCXD0,"PAR",0)) ^OCXS(863.3,OCXD0,"PAR",0)="^863.32P^^"
S DA(1)=OCXD0,OCXY=+$$DIC("^OCXS(863.3,"_OCXD0_",""PAR"",","ML","",PNAME,"","",.DA) Q:(OCXY<1)
S DA(1)=OCXD0,DA=+OCXY,OCXZ=$$DIE("^OCXS(863.3,"_OCXD0_",""PAR"",",.DA,1,PVAL)
Q
;
FIELD(OCXHDR) ;
;
Q OCXTHLN_$G(OCXHDR)_OCXTNLN
;
DATA(OCXVAL,OCXLEN) ;
;
N SPACES S SPACES="",$P(SPACES," ",OCXLEN+5)=" ",OCXVAL=$G(OCXVAL)
I ($L(OCXVAL)>OCXLEN) Q $E(OCXVAL,1,OCXLEN-3)_"..."
Q $E((OCXVAL_SPACES),1,OCXLEN)
;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
N OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
Q:'$L($G(OCXZ0)) U
S DIR(0)=OCXZ0
S:$L($G(OCXZA)) DIR("A")=OCXZA
S:$L($G(OCXZB)) DIR("B")=OCXZB
F OCXLINE=1:1:($G(OCXZL)-1) W !
D ^DIR
I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
Q Y
;
DIE(DIE,DA,OCXFLD,OCXVAL) ;
;
N DUOUT,DTOUT,DIC
S DR=OCXFLD_"///^S X=OCXVAL"
S DIC=DIE D RM(IOM) D ^DIE D RM(0) Q:$G(DTOUT) 0 Q:$G(DUOUT) 0 Q 1
;
RM(X) X ^%ZOSF("RM") Q
;
MDIE(DIE,DA,DR) ;
;
N DUOUT,DTOUT,DIC
S DIC=DIE D RM(IOM) D ^DIE D RM(0) Q:$G(DTOUT) 0 Q:$G(DUOUT) 0 Q 1
;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR,DA) ;
;
N DIC,X,Y
S DIC=$G(OCXDIC) Q:'$L(DIC) -1
S DIC(0)=$G(OCXDIC0) S:$L($G(OCXX)) X=OCXX
S:$L($G(OCXDICS)) DIC("S")=OCXDICS
S:$L($G(OCXDICA)) DIC("A")=OCXDICA
S:$L($G(OCXDR)) DIC("DR")=OCXDR
D ^DIC Q:(Y<1) 0 Q Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOED14 3392 printed Dec 13, 2024@02:25:28 Page 2
OCXOED14 ;SLC/RJS,CLA - Rule Editor (Meta Dictionary Link Options) ;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ;
S ;
+1 ;
+2 QUIT
EN(OCXD0,OCXRD,OCXACT) ;
+1 ;
+2 ;
+3 NEW OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
+4 ;
+5 SET OCXTNLN=$CHAR(27,91,48,109)
SET OCXTRLN=$CHAR(27,91,55,109)
SET OCXTULN=$CHAR(27,91,52,109)
SET OCXTHLN=$CHAR(27,91,49,109)
+6 ;
+7 SET OCXOPT=$$GETOPT^OCXOEDT(.OCXACT)
if (OCXOPT=U)
QUIT 1
if $LENGTH(OCXOPT)
XECUTE OCXOPT
+8 ;
+9 if '$DATA(^OCXS(863.3,OCXD0))
QUIT 1
+10 ;
+11 QUIT 0
+12 ;
EDATT(OCXD0) ;
+1 ;
+2 NEW OCXX
+3 SET OCXX=$$MDIE("^OCXS(863.3,",OCXD0,".05")
+4 QUIT
+5 ;
EDPARAM(OCXD0,PARNAM) ;
+1 ;
+2 NEW NEWVAL,OLDVAL
+3 SET OLDVAL=$$GLPVAL(OCXD0,PARNAM)
+4 WRITE !!
+5 WRITE " ",$$FIELD("Link Parameter -> "_PARNAM_": ")
+6 WRITE !!,"-> "
if $LENGTH(OLDVAL)
WRITE OLDVAL_" // "
+7 WRITE !,"-> "
+8 READ NEWVAL:DTIME
IF '$TEST
QUIT
+9 IF '$LENGTH(NEWVAL)
SET NEWVAL=$$SCREEN^OCXOED12(OLDVAL)
if '(NEWVAL=OLDVAL)
DO SLPVAL(OCXD0,PARNAM,NEWVAL)
QUIT
+10 IF (NEWVAL="@")
WRITE !
if '$$READ("Y","Are you sure you want to delete this value ?","YES")
QUIT
+11 if (NEWVAL["|")
SET NEWVAL=$$SCREEN^OCXOED12(NEWVAL)
DO SLPVAL(OCXD0,PARNAM,NEWVAL)
+12 QUIT
+13 ;
EDPATT(OCXD0,PNAME) ;
+1 ;
+2 NEW OLDVAL,NEWVAL,OCXX,OCXY,OCXZ,DA,OCXPR
+3 ;
+4 SET OLDVAL=""
SET OCXX=""
FOR
SET OCXX=$ORDER(OCXRD("ATT",OCXD0,"PAR",OCXX))
if 'OCXX
QUIT
IF ($GET(OCXRD("ATT",OCXD0,"PAR",OCXX,.01,"E"))=PNAME)
QUIT
+5 if OCXX
SET OLDVAL=$GET(OCXRD("ATT",OCXD0,"PAR",OCXX,1,"E"))
+6 ;
+7 WRITE !!
+8 SET OCXPR=$$FIELD("Attribute Parameter -> "_PNAME_": ")
if $LENGTH(OLDVAL)
SET OCXPR=OCXPR_OLDVAL_" // "
+9 SET NEWVAL=$$DIC("^OCXS(864.1,","AEMQ",OCXPR)
+10 ;
+11 if '$DATA(^OCXS(863.4,OCXD0,"PAR",0))
SET ^OCXS(863.4,OCXD0,"PAR",0)="^863.41PI^^"
+12 SET DA(1)=OCXD0
SET OCXY=+$$DIC("^OCXS(863.4,"_OCXD0_",""PAR"",","ML","",PNAME,"","",.DA)
if (OCXY<1)
QUIT
+13 SET DA(1)=OCXD0
SET DA=+OCXY
SET OCXZ=$$DIE("^OCXS(863.4,"_OCXD0_",""PAR"",",.DA,1,$PIECE(NEWVAL,U,2))
+14 QUIT
+15 ;
GLPVAL(OCXD0,PNAME) ;
+1 NEW X
SET X=""
FOR
SET X=$ORDER(OCXRD("LINK",OCXD0,"PAR",X))
if 'X
QUIT
IF ($GET(OCXRD("LINK",OCXD0,"PAR",X,.01,"E"))=PNAME)
QUIT
+2 if 'X
QUIT ""
QUIT $GET(OCXRD("LINK",OCXD0,"PAR",X,1,"E"))
+3 ;
SLPVAL(OCXD0,PNAME,PVAL) ;
+1 NEW DA,OCXY,OCXZ
+2 if '$DATA(^OCXS(863.4,OCXD0,"PAR",0))
SET ^OCXS(863.3,OCXD0,"PAR",0)="^863.32P^^"
+3 SET DA(1)=OCXD0
SET OCXY=+$$DIC("^OCXS(863.3,"_OCXD0_",""PAR"",","ML","",PNAME,"","",.DA)
if (OCXY<1)
QUIT
+4 SET DA(1)=OCXD0
SET DA=+OCXY
SET OCXZ=$$DIE("^OCXS(863.3,"_OCXD0_",""PAR"",",.DA,1,PVAL)
+5 QUIT
+6 ;
FIELD(OCXHDR) ;
+1 ;
+2 QUIT OCXTHLN_$GET(OCXHDR)_OCXTNLN
+3 ;
DATA(OCXVAL,OCXLEN) ;
+1 ;
+2 NEW SPACES
SET SPACES=""
SET $PIECE(SPACES," ",OCXLEN+5)=" "
SET OCXVAL=$GET(OCXVAL)
+3 IF ($LENGTH(OCXVAL)>OCXLEN)
QUIT $EXTRACT(OCXVAL,1,OCXLEN-3)_"..."
+4 QUIT $EXTRACT((OCXVAL_SPACES),1,OCXLEN)
+5 ;
READ(OCXZ0,OCXZA,OCXZB,OCXZL) ;
+1 NEW OCXLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 if '$LENGTH($GET(OCXZ0))
QUIT U
+3 SET DIR(0)=OCXZ0
+4 if $LENGTH($GET(OCXZA))
SET DIR("A")=OCXZA
+5 if $LENGTH($GET(OCXZB))
SET DIR("B")=OCXZB
+6 FOR OCXLINE=1:1:($GET(OCXZL)-1)
WRITE !
+7 DO ^DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT)
QUIT U
+9 QUIT Y
+10 ;
DIE(DIE,DA,OCXFLD,OCXVAL) ;
+1 ;
+2 NEW DUOUT,DTOUT,DIC
+3 SET DR=OCXFLD_"///^S X=OCXVAL"
+4 SET DIC=DIE
DO RM(IOM)
DO ^DIE
DO RM(0)
if $GET(DTOUT)
QUIT 0
if $GET(DUOUT)
QUIT 0
QUIT 1
+5 ;
RM(X) XECUTE ^%ZOSF("RM")
QUIT
+1 ;
MDIE(DIE,DA,DR) ;
+1 ;
+2 NEW DUOUT,DTOUT,DIC
+3 SET DIC=DIE
DO RM(IOM)
DO ^DIE
DO RM(0)
if $GET(DTOUT)
QUIT 0
if $GET(DUOUT)
QUIT 0
QUIT 1
+4 ;
DIC(OCXDIC,OCXDIC0,OCXDICA,OCXX,OCXDICS,OCXDR,DA) ;
+1 ;
+2 NEW DIC,X,Y
+3 SET DIC=$GET(OCXDIC)
if '$LENGTH(DIC)
QUIT -1
+4 SET DIC(0)=$GET(OCXDIC0)
if $LENGTH($GET(OCXX))
SET X=OCXX
+5 if $LENGTH($GET(OCXDICS))
SET DIC("S")=OCXDICS
+6 if $LENGTH($GET(OCXDICA))
SET DIC("A")=OCXDICA
+7 if $LENGTH($GET(OCXDR))
SET DIC("DR")=OCXDR
+8 DO ^DIC
if (Y<1)
QUIT 0
QUIT Y
+9 ;
