source: FOIAVistA/tag/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMPN.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1OCXOCMPN ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Construct Rule MetaCode Subroutines) ;10/29/98 12:37
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5MC(CODE,ELEM) ;
6 ;
7 N INDEX1,INDEX2,LEVL
8 ;
9 S INDEX1=0 F S INDEX1=$O(CODE(INDEX1)) Q:'INDEX1 D
10 .I ($E(CODE(INDEX1),1,10)="I $L(OCXDF") D
11 ..N DFLD S DFLD=(+$P(CODE(INDEX1),"OCXDF(",2))
12 ..D INSERT(INDEX1+1,"S OCXRES("_(+ELEM)_","_(DFLD)_")=OCXDF("_(+DFLD)_")","S")
13 ;
14 D INSERT(1,";","Y")
15 S INDEX1=0 F S INDEX1=$O(CODE(INDEX1)) Q:'INDEX1 D
16 .I ($E(CODE(INDEX1),1,7)="S OCXDF") D
17 ..N DFLD S DFLD=(+$P(CODE(INDEX1),"OCXDF(",2)),INDEX1=INDEX1+1
18 ..D INSERT(1,"; OCXDF("_(+DFLD)_") -> "_$P($G(^OCXS(860.4,+DFLD,0)),U,1)_" data field","Y")
19 ;
20 S (LEVL,INDEX1)=0 F S INDEX1=$O(CODE(INDEX1)) Q:'INDEX1 D
21 .I (CODE(INDEX1,"OPLIST")="Y") S LEVL=0 Q
22 .S INDEX2=INDEX1 F S INDEX2=$O(CODE(INDEX2)) Q:'INDEX2 Q:(CODE(INDEX2,"OPLIST")="Y") D
23 ..;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
24 ..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
25 ..I ($E(CODE(INDEX1,"OPLIST"),$L(CODE(INDEX1,"OPLIST")))=CODE(INDEX2,"OPLIST")) D Q
26 ...S CODE(INDEX1)=CODE(INDEX1)_","_$P(CODE(INDEX2)," ",2,999) K CODE(INDEX2)
27 ..S CODE(INDEX1)=CODE(INDEX1)_" "_CODE(INDEX2)
28 ..S CODE(INDEX1,"OPLIST")=CODE(INDEX1,"OPLIST")_CODE(INDEX2,"OPLIST")
29 ..K CODE(INDEX2)
30 ;
31 Q
32 ;
33INSERT(X,T,O) ;
34 ;
35 N Y,LAST
36 S LAST=$O(CODE(99999),-1)
37 F Y=LAST:-1:X M CODE(Y+1)=CODE(Y)
38 S CODE(X)=T
39 S CODE(X,"OPLIST")=O
40 Q
41 ;
Note: See TracBrowser for help on using the repository browser.