- OCXOED16 ;SLC/RJS,CLA - Rule Editor (Expert System Editor Options) ;6/19/01 16:35
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
- ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- ;
- ;
- S ;
- ;
- Q
- EN(OCXACT) ;
- ;
- ;
- N OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
- ;
- S OCXOPT=$$GETOPT^OCXOEDT(.OCXACT) Q:(OCXOPT=U) 1 X:$L(OCXOPT) OCXOPT
- ;
- Q 0
- ;
- EDRULE ;
- ;
- N OCXY F W !! S OCXY=+$$DIC("^OCXS(860.2,","AEMQNL","Select Rule: ") Q:'OCXY D EN^OCXOED01(OCXY)
- ;
- Q
- ;
- EDELEM ;
- ;
- N OCXY F W !! S OCXY=+$$DIC("^OCXS(860.3,","AEMQNL","Select Element: ") Q:'OCXY D EN^OCXOED07(OCXY)
- ;
- Q
- ;
- EDDF ;
- ;
- N OCXY F W !! S OCXY=+$$DIC("^OCXS(860.4,","AEMQNL","Select Data Field: ") Q:'OCXY D EN^OCXOED11(OCXY)
- ;
- Q
- ;
- EDMDD ;
- ;
- N OCXY F W !! S OCXY=$$DIC("^OCXS(863.3,","AEMQNL","Select Link: ") Q:'OCXY D EN^OCXOED13($P(OCXY,U,2))
- ;
- Q
- ;
- COMP D ^OCXOCMP Q
- ;
- SCANDF D SELECT^OCXOSCR1 Q
- ;
- SCANEL D SELECT^OCXOSCR2 Q
- ;
- EDPARAM(OCXD0,PARNAM) ;
- ;
- N NEWVAL
- W !!
- W " ",$$FIELD("Link Parameter -> "_PARNAM_": ")
- W:$L($$GLPVAL(OCXD0,PARNAM)) $$GLPVAL(OCXD0,PARNAM)_" // "
- R NEWVAL:30 E Q
- I (NEWVAL="@") W ! Q:'$$READ("Y","Are you sure you want to delete this value ?","YES")
- D SLPVAL(OCXD0,PARNAM,NEWVAL)
- 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 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
- ;
- 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[HOCXOED16 2706 printed Feb 18, 2025@23:52:03 Page 2
- OCXOED16 ;SLC/RJS,CLA - Rule Editor (Expert System Editor Options) ;6/19/01 16:35
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,105**;Dec 17,1997
- +2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
- +3 ;
- +4 ;
- S ;
- +1 ;
- +2 QUIT
- EN(OCXACT) ;
- +1 ;
- +2 ;
- +3 NEW OCXTHLN,OCXTNLN,OCXTRLN,OCXTULN,OCXTNLN
- +4 ;
- +5 SET OCXOPT=$$GETOPT^OCXOEDT(.OCXACT)
- if (OCXOPT=U)
- QUIT 1
- if $LENGTH(OCXOPT)
- XECUTE OCXOPT
- +6 ;
- +7 QUIT 0
- +8 ;
- EDRULE ;
- +1 ;
- +2 NEW OCXY
- FOR
- WRITE !!
- SET OCXY=+$$DIC("^OCXS(860.2,","AEMQNL","Select Rule: ")
- if 'OCXY
- QUIT
- DO EN^OCXOED01(OCXY)
- +3 ;
- +4 QUIT
- +5 ;
- EDELEM ;
- +1 ;
- +2 NEW OCXY
- FOR
- WRITE !!
- SET OCXY=+$$DIC("^OCXS(860.3,","AEMQNL","Select Element: ")
- if 'OCXY
- QUIT
- DO EN^OCXOED07(OCXY)
- +3 ;
- +4 QUIT
- +5 ;
- EDDF ;
- +1 ;
- +2 NEW OCXY
- FOR
- WRITE !!
- SET OCXY=+$$DIC("^OCXS(860.4,","AEMQNL","Select Data Field: ")
- if 'OCXY
- QUIT
- DO EN^OCXOED11(OCXY)
- +3 ;
- +4 QUIT
- +5 ;
- EDMDD ;
- +1 ;
- +2 NEW OCXY
- FOR
- WRITE !!
- SET OCXY=$$DIC("^OCXS(863.3,","AEMQNL","Select Link: ")
- if 'OCXY
- QUIT
- DO EN^OCXOED13($PIECE(OCXY,U,2))
- +3 ;
- +4 QUIT
- +5 ;
- COMP DO ^OCXOCMP
- QUIT
- +1 ;
- SCANDF DO SELECT^OCXOSCR1
- QUIT
- +1 ;
- SCANEL DO SELECT^OCXOSCR2
- QUIT
- +1 ;
- EDPARAM(OCXD0,PARNAM) ;
- +1 ;
- +2 NEW NEWVAL
- +3 WRITE !!
- +4 WRITE " ",$$FIELD("Link Parameter -> "_PARNAM_": ")
- +5 if $LENGTH($$GLPVAL(OCXD0,PARNAM))
- WRITE $$GLPVAL(OCXD0,PARNAM)_" // "
- +6 READ NEWVAL:30
- IF '$TEST
- QUIT
- +7 IF (NEWVAL="@")
- WRITE !
- if '$$READ("Y","Are you sure you want to delete this value ?","YES")
- QUIT
- +8 DO SLPVAL(OCXD0,PARNAM,NEWVAL)
- +9 QUIT
- +10 ;
- 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 SET DA(1)=OCXD0
- SET OCXY=+$$DIC("^OCXS(863.3,"_OCXD0_",""PAR"",","ML","",PNAME,"","",.DA)
- if (OCXY<1)
- QUIT
- +3 SET DA(1)=OCXD0
- SET DA=+OCXY
- SET OCXZ=$$DIE("^OCXS(863.3,"_OCXD0_",""PAR"",",.DA,1,PVAL)
- +4 QUIT
- +5 ;
- 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 ;
- 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 ;