VistA-WorldVistAEHR/r/ORDER_ENTRY_RESULTS_REPORTI.../OCXOCMPN.m

42 lines
1.7 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
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
;