OCXOCMP7 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build Local Extrinsic Functions) ;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
;
;
EN(OCXFUNC,OCXCODE) ;
;
N OCXLN,OCXTXT,OCXRTN,OCXRLN,OCXTR,OCXFLN,OCXRNAM
S OCXRTN=$O(^OCXS(860.8,"C",OCXFUNC,0)) Q:'OCXRTN
S OCXCODE=$G(OCXCODE),OCXFLN=$O(OCXCODE(""),-1)+1,OCXRNAM=$P($G(^OCXS(860.8,+OCXRTN,0)),U,1)
;
S OCXLN=0 F S OCXLN=$O(^OCXS(860.8,OCXRTN,"CODE",OCXLN)) Q:'OCXLN D
.S OCXTXT=$G(^(OCXLN,0))
.S OCXRLN=$P(OCXTXT,";",2,999)
.S OCXTR=$P(OCXTXT,";",1)
.S:'$L(OCXRLN) OCXRLN=" ;"
.;
.F Q:'(OCXRLN["%%%%") S OCXRLN=$P(OCXRLN,"""%%%%""",1)_"||LNTAG||"_$P(OCXRLN,"""%%%%""",2,999)
.;
.I '(OCXTR["T"),'(OCXTR["L") S OCXCODE=OCXCODE+$L(OCXRLN),OCXCODE($O(OCXCODE(""),-1)+1)=OCXRLN Q
.;
.I (OCXTR["T"),(OCXTR["-"),'$G(OCXTRACE) S OCXCODE=OCXCODE+$L(OCXRLN),OCXCODE($O(OCXCODE(""),-1)+1)=OCXRLN Q
.I (OCXTR["T"),(OCXTR["+"),$G(OCXTRACE) S OCXCODE=OCXCODE+$L(OCXRLN),OCXCODE($O(OCXCODE(""),-1)+1)=OCXRLN Q
.;
.I (OCXTR["L"),(OCXTR["-"),'$G(OCXTLOG) S OCXCODE=OCXCODE+$L(OCXRLN),OCXCODE($O(OCXCODE(""),-1)+1)=OCXRLN Q
.I (OCXTR["L"),(OCXTR["+"),$G(OCXTLOG) S OCXCODE=OCXCODE+$L(OCXRLN),OCXCODE($O(OCXCODE(""),-1)+1)=OCXRLN Q
;
I $L(OCXRNAM),$D(OCXCODE(OCXFLN)) S OCXCODE(OCXFLN)=OCXCODE(OCXFLN)_" ; "_OCXRNAM
;
Q
;
METACODE(OCXFUNC,OCXCODE) ;
;
N OCXELE,INDEX
S OCXELE=+$P(OCXFUNC,"E",2) Q:'OCXELE
D FILE(OCXFUNC_"() ; Verify Event/Element: '"_$P($G(^OCXS(860.3,+OCXELE,0)),U,1)_"'")
D FILE(" ;")
S INDEX1=$O(^TMP("OCXCMP",$J,"METACODE","B",OCXELE,0))
I INDEX1 S INDEX2=0 F S INDEX2=$O(^TMP("OCXCMP",$J,"METACODE",INDEX1,INDEX2)) Q:'INDEX2 D FILE(" "_^(INDEX2))
D FILE(" ;")
Q
;
FILE(X) ;
S OCXCODE($O(OCXCODE(999999),-1)+1)=X,OCXCODE=$G(OCXCODE)+$L(X)
Q
;
DFLIST(OCXELE) ;
;
N LIST,DF
S LIST="",DF=0 F S DF=$O(^TMP("OCXCMP",$J,"ELEMENT",OCXELE,"DATA",DF)) Q:'DF S:$L(LIST) LIST=LIST_"," S LIST=LIST_DF
Q LIST
;
OCXOCMP7 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Build Local Extrinsic Functions) ;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ;
EN(OCXFUNC,OCXCODE) ;
+1 ;
+2 NEW OCXLN,OCXTXT,OCXRTN,OCXRLN,OCXTR,OCXFLN,OCXRNAM
+3 SET OCXRTN=$ORDER(^OCXS(860.8,"C",OCXFUNC,0))
IF 'OCXRTN
QUIT
+4 SET OCXCODE=$GET(OCXCODE)
SET OCXFLN=$ORDER(OCXCODE(""),-1)+1
SET OCXRNAM=$PIECE($GET(^OCXS(860.8,+OCXRTN,0)),U,1)
+5 ;
+6 SET OCXLN=0
FOR
SET OCXLN=$ORDER(^OCXS(860.8,OCXRTN,"CODE",OCXLN))
IF 'OCXLN
QUIT
Begin DoDot:1
+7 SET OCXTXT=$GET(^(OCXLN,0))
+8 SET OCXRLN=$PIECE(OCXTXT,";",2,999)
+9 SET OCXTR=$PIECE(OCXTXT,";",1)
+10 IF '$LENGTH(OCXRLN)
SET OCXRLN=" ;"
+11 ;
+12 FOR
IF '(OCXRLN["%%%%")
QUIT
SET OCXRLN=$PIECE(OCXRLN,"""%%%%""",1)_"||LNTAG||"_$PIECE(OCXRLN,"""%%%%""",2,999)
+13 ;
+14 IF '(OCXTR["T")
IF '(OCXTR["L")
SET OCXCODE=OCXCODE+$LENGTH(OCXRLN)
SET OCXCODE($ORDER(OCXCODE(""),-1)+1)=OCXRLN
QUIT
+15 ;
+16 IF (OCXTR["T")
IF (OCXTR["-")
IF '$GET(OCXTRACE)
SET OCXCODE=OCXCODE+$LENGTH(OCXRLN)
SET OCXCODE($ORDER(OCXCODE(""),-1)+1)=OCXRLN
QUIT
+17 IF (OCXTR["T")
IF (OCXTR["+")
IF $GET(OCXTRACE)
SET OCXCODE=OCXCODE+$LENGTH(OCXRLN)
SET OCXCODE($ORDER(OCXCODE(""),-1)+1)=OCXRLN
QUIT
+18 ;
+19 IF (OCXTR["L")
IF (OCXTR["-")
IF '$GET(OCXTLOG)
SET OCXCODE=OCXCODE+$LENGTH(OCXRLN)
SET OCXCODE($ORDER(OCXCODE(""),-1)+1)=OCXRLN
QUIT
+20 IF (OCXTR["L")
IF (OCXTR["+")
IF $GET(OCXTLOG)
SET OCXCODE=OCXCODE+$LENGTH(OCXRLN)
SET OCXCODE($ORDER(OCXCODE(""),-1)+1)=OCXRLN
QUIT
End DoDot:1
+21 ;
+22 IF $LENGTH(OCXRNAM)
IF $DATA(OCXCODE(OCXFLN))
SET OCXCODE(OCXFLN)=OCXCODE(OCXFLN)_" ; "_OCXRNAM
+23 ;
+24 QUIT
+25 ;
METACODE(OCXFUNC,OCXCODE) ;
+1 ;
+2 NEW OCXELE,INDEX
+3 SET OCXELE=+$PIECE(OCXFUNC,"E",2)
IF 'OCXELE
QUIT
+4 DO FILE(OCXFUNC_"() ; Verify Event/Element: '"_$PIECE($GET(^OCXS(860.3,+OCXELE,0)),U,1)_"'")
+5 DO FILE(" ;")
+6 SET INDEX1=$ORDER(^TMP("OCXCMP",$JOB,"METACODE","B",OCXELE,0))
+7 IF INDEX1
SET INDEX2=0
FOR
SET INDEX2=$ORDER(^TMP("OCXCMP",$JOB,"METACODE",INDEX1,INDEX2))
IF 'INDEX2
QUIT
DO FILE(" "_^(INDEX2))
+8 DO FILE(" ;")
+9 QUIT
+10 ;
FILE(X) ;
+1 SET OCXCODE($ORDER(OCXCODE(999999),-1)+1)=X
SET OCXCODE=$GET(OCXCODE)+$LENGTH(X)
+2 QUIT
+3 ;
DFLIST(OCXELE) ;
+1 ;
+2 NEW LIST,DF
+3 SET LIST=""
SET DF=0
FOR
SET DF=$ORDER(^TMP("OCXCMP",$JOB,"ELEMENT",OCXELE,"DATA",DF))
IF 'DF
QUIT
IF $LENGTH(LIST)
SET LIST=LIST_","
SET LIST=LIST_DF
+4 QUIT LIST
+5 ;
