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
 ;