42 lines
1.7 KiB
Mathematica
42 lines
1.7 KiB
Mathematica
OCXOCMPN ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Construct Rule MetaCode Subroutines) ;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
|
|
;
|
|
MC(CODE,ELEM) ;
|
|
;
|
|
N INDEX1,INDEX2,LEVL
|
|
;
|
|
S INDEX1=0 F S INDEX1=$O(CODE(INDEX1)) Q:'INDEX1 D
|
|
.I ($E(CODE(INDEX1),1,10)="I $L(OCXDF") D
|
|
..N DFLD S DFLD=(+$P(CODE(INDEX1),"OCXDF(",2))
|
|
..D INSERT(INDEX1+1,"S OCXRES("_(+ELEM)_","_(DFLD)_")=OCXDF("_(+DFLD)_")","S")
|
|
;
|
|
D INSERT(1,";","Y")
|
|
S INDEX1=0 F S INDEX1=$O(CODE(INDEX1)) Q:'INDEX1 D
|
|
.I ($E(CODE(INDEX1),1,7)="S OCXDF") D
|
|
..N DFLD S DFLD=(+$P(CODE(INDEX1),"OCXDF(",2)),INDEX1=INDEX1+1
|
|
..D INSERT(1,"; OCXDF("_(+DFLD)_") -> "_$P($G(^OCXS(860.4,+DFLD,0)),U,1)_" data field","Y")
|
|
;
|
|
S (LEVL,INDEX1)=0 F S INDEX1=$O(CODE(INDEX1)) Q:'INDEX1 D
|
|
.I (CODE(INDEX1,"OPLIST")="Y") S LEVL=0 Q
|
|
.S INDEX2=INDEX1 F S INDEX2=$O(CODE(INDEX2)) Q:'INDEX2 Q:(CODE(INDEX2,"OPLIST")="Y") D
|
|
..;I (($L(CODE(INDEX1))+$L(CODE(INDEX2)))>70) S LEVL=LEVL+1,CODE(INDEX1)=CODE(INDEX1)_" D",CODE(INDEX2)=$E("...........",1,LEVL)_CODE(INDEX2),INDEX2=99999 Q
|
|
..I (($L(CODE(INDEX1))+$L(CODE(INDEX2)))>OCXCLL) S LEVL=LEVL+1,CODE(INDEX1)=CODE(INDEX1)_" D",CODE(INDEX2)=$E("...........",1,LEVL)_CODE(INDEX2),INDEX2=99999 Q
|
|
..I ($E(CODE(INDEX1,"OPLIST"),$L(CODE(INDEX1,"OPLIST")))=CODE(INDEX2,"OPLIST")) D Q
|
|
...S CODE(INDEX1)=CODE(INDEX1)_","_$P(CODE(INDEX2)," ",2,999) K CODE(INDEX2)
|
|
..S CODE(INDEX1)=CODE(INDEX1)_" "_CODE(INDEX2)
|
|
..S CODE(INDEX1,"OPLIST")=CODE(INDEX1,"OPLIST")_CODE(INDEX2,"OPLIST")
|
|
..K CODE(INDEX2)
|
|
;
|
|
Q
|
|
;
|
|
INSERT(X,T,O) ;
|
|
;
|
|
N Y,LAST
|
|
S LAST=$O(CODE(99999),-1)
|
|
F Y=LAST:-1:X M CODE(Y+1)=CODE(Y)
|
|
S CODE(X)=T
|
|
S CODE(X,"OPLIST")=O
|
|
Q
|
|
;
|