OCXOCMP8 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Assemble Order Check Routines utilities) ;10/29/98 12:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
Q
FILE(RNUM) ;
;
W:'$G(OCXAUTO) !,$$RNAM(RNUM)
N DIE,XCN,X
S DIE="^TMP(""OCXCMP"",$J,""D CODE"","_RNUM_",",XCN=0,X=$$RNAM(RNUM)
X ^%ZOSF("SAVE")
Q
;
APPEND(DSUB,CSUB,SRC,LABEL) ;
;
N OCXSRC,OCXNDX,OCXNEXT,GLD,GLC
S GLD="^TMP(""OCXCMP"",$J,""D CODE"","_(+DSUB)_")"
I (CSUB="$") D Q
.S OCXNEXT=$O(@GLD@(" "),-1)+1
.S @GLD@(OCXNEXT,0)="$"
.S OCXNEXT=$O(@GLD@(" "),-1)+1
.S @GLD@(OCXNEXT,0)=""
;
I (SRC="C") M GLC=^TMP("OCXCMP",$J,"C CODE",+CSUB) S ^TMP("OCXCMP",$J,"D CODE","LINE",LABEL)=DSUB_","_($O(@GLD@(" "),-1)+1)
I (SRC="F") M GLC=^TMP("OCXCMP",$J,"INCLUDE",CSUB)
S OCXNDX=0 F S OCXNDX=$O(GLC(OCXNDX)) Q:'OCXNDX D
.S OCXNEXT=$O(@GLD@(" "),-1)+1
.S @GLD@(OCXNEXT,0)=GLC(OCXNDX,0)
M @GLD@("CALLS")=GLC("CALLS")
S @GLD@("SIZE")=$G(@GLD@("SIZE"))+$G(GLC("SIZE"))
Q
;
SIZE(DSUB,CSUB) ;
;
N D0,EFC,OCXEFC,OCXEFD,OCXEFF,OCXREC
N OCXTEMP,PIEC,SIZEC,SIZED,SIZEF,TEXT
;
S (SIZEC,SIZED,SIZEF)=0
K OCXEFF,OCXEFC,OCXEFD
S (OCXEFF,OCXEFC,OCXEFD)=""
;
I $G(CSUB),$D(^TMP("OCXCMP",$J,"C CODE",+CSUB)) D
.I $D(^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")) D Q
..S SIZEC=^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")
..I $D(^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")) D
...K OCXEFC M OCXEFC=^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")
.K OCXREC M OCXREC=^TMP("OCXCMP",$J,"C CODE",+CSUB)
.S D0=0 F S D0=$O(OCXREC(D0)) Q:'D0 D
..S TEXT=OCXREC(D0,0),SIZEC=SIZEC+$L(TEXT)
..Q:'(TEXT["$$")
..F PIEC=2:1:$L(TEXT,"$$") D
...S EFC=$P($P(TEXT,"$$",PIEC),"(",1)
...S:(EFC[" ") EFC=$P(EFC," ",1) Q:(EFC["^") Q:'$L(EFC)
...I '$D(^TMP("OCXCMP",$J,"INCLUDE",EFC)) D Q
....D WARN^OCXOCMPV("Unknown Local Extrinsic Function: "_EFC,$P($T(+1)," ",1)) Q
...S OCXEFC(EFC)=""
.S SIZEC=SIZEC+100 ; ADJUST FOR SUBROUTINE DOCUMENTATION
.S ^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")=SIZEC
.M ^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")=OCXEFC
;
I $G(DSUB),$D(^TMP("OCXCMP",$J,"D CODE",+DSUB)) D
.I $G(^TMP("OCXCMP",$J,"D CODE",+DSUB,"SIZE")) D Q
..S SIZED=^TMP("OCXCMP",$J,"D CODE",+DSUB,"SIZE")
..I $D(^TMP("OCXCMP",$J,"D CODE",+DSUB,"CALLS")) D
...K OCXEFD M OCXEFD=^TMP("OCXCMP",$J,"D CODE",+DSUB,"CALLS")
;
K OCXEFF M OCXEFF=OCXEFC,OCXEFF=OCXEFD
;
I $D(OCXEFF) S EFC="" F S EFC=$O(OCXEFF(EFC)) Q:'$L(EFC) I 'OCXEFF(EFC) D
.K OCXTEMP
.I $D(^TMP("OCXCMP",$J,"INCLUDE",EFC,"SIZE")) M OCXTEMP("SIZE")=^TMP("OCXCMP",$J,"INCLUDE",EFC,"SIZE")
.I $D(^TMP("OCXCMP",$J,"INCLUDE",EFC,"CALLS")) M OCXTEMP("CALLS")=^TMP("OCXCMP",$J,"INCLUDE",EFC,"CALLS")
.S OCXEFF(EFC)=OCXTEMP("SIZE")
.Q:'$D(OCXTEMP("CALLS"))
.S EFC="" F S EFC=$O(OCXTEMP("CALLS",EFC)) Q:'$L(EFC) S OCXEFF(EFC)=+$G(OCXEFF(EFC))
;
I $D(OCXEFF) S EFC="" F S EFC=$O(OCXEFF(EFC)) Q:'$L(EFC) S SIZEF=SIZEF+OCXEFF(EFC)
;
Q $G(SIZEC)+$G(SIZED)+$G(SIZEF)
;
RNAM(X) ;
N CHAR
S CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Q "OCXOZ"_$E(CHAR,(X\36+1))_$E(CHAR,(X#36+1))
;
TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT X ^DD("DD") Q Y
;
NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT X ^DD("DD") S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2,99) Q Y
;
OCXOCMP8 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Assemble Order Check Routines utilities) ;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 QUIT
FILE(RNUM) ;
+1 ;
+2 IF '$GET(OCXAUTO)
WRITE !,$$RNAM(RNUM)
+3 NEW DIE,XCN,X
+4 SET DIE="^TMP(""OCXCMP"",$J,""D CODE"","_RNUM_","
SET XCN=0
SET X=$$RNAM(RNUM)
+5 XECUTE ^%ZOSF("SAVE")
+6 QUIT
+7 ;
APPEND(DSUB,CSUB,SRC,LABEL) ;
+1 ;
+2 NEW OCXSRC,OCXNDX,OCXNEXT,GLD,GLC
+3 SET GLD="^TMP(""OCXCMP"",$J,""D CODE"","_(+DSUB)_")"
+4 IF (CSUB="$")
Begin DoDot:1
+5 SET OCXNEXT=$ORDER(@GLD@(" "),-1)+1
+6 SET @GLD@(OCXNEXT,0)="$"
+7 SET OCXNEXT=$ORDER(@GLD@(" "),-1)+1
+8 SET @GLD@(OCXNEXT,0)=""
End DoDot:1
QUIT
+9 ;
+10 IF (SRC="C")
MERGE GLC=^TMP("OCXCMP",$JOB,"C CODE",+CSUB)
SET ^TMP("OCXCMP",$JOB,"D CODE","LINE",LABEL)=DSUB_","_($ORDER(@GLD@(" "),-1)+1)
+11 IF (SRC="F")
MERGE GLC=^TMP("OCXCMP",$JOB,"INCLUDE",CSUB)
+12 SET OCXNDX=0
FOR
SET OCXNDX=$ORDER(GLC(OCXNDX))
IF 'OCXNDX
QUIT
Begin DoDot:1
+13 SET OCXNEXT=$ORDER(@GLD@(" "),-1)+1
+14 SET @GLD@(OCXNEXT,0)=GLC(OCXNDX,0)
End DoDot:1
+15 MERGE @GLD@("CALLS")=GLC("CALLS")
+16 SET @GLD@("SIZE")=$GET(@GLD@("SIZE"))+$GET(GLC("SIZE"))
+17 QUIT
+18 ;
SIZE(DSUB,CSUB) ;
+1 ;
+2 NEW D0,EFC,OCXEFC,OCXEFD,OCXEFF,OCXREC
+3 NEW OCXTEMP,PIEC,SIZEC,SIZED,SIZEF,TEXT
+4 ;
+5 SET (SIZEC,SIZED,SIZEF)=0
+6 KILL OCXEFF,OCXEFC,OCXEFD
+7 SET (OCXEFF,OCXEFC,OCXEFD)=""
+8 ;
+9 IF $GET(CSUB)
IF $DATA(^TMP("OCXCMP",$JOB,"C CODE",+CSUB))
Begin DoDot:1
+10 IF $DATA(^TMP("OCXCMP",$JOB,"C CODE",+CSUB,"SIZE"))
Begin DoDot:2
+11 SET SIZEC=^TMP("OCXCMP",$JOB,"C CODE",+CSUB,"SIZE")
+12 IF $DATA(^TMP("OCXCMP",$JOB,"C CODE",+CSUB,"CALLS"))
Begin DoDot:3
+13 KILL OCXEFC
MERGE OCXEFC=^TMP("OCXCMP",$JOB,"C CODE",+CSUB,"CALLS")
End DoDot:3
End DoDot:2
QUIT
+14 KILL OCXREC
MERGE OCXREC=^TMP("OCXCMP",$JOB,"C CODE",+CSUB)
+15 SET D0=0
FOR
SET D0=$ORDER(OCXREC(D0))
IF 'D0
QUIT
Begin DoDot:2
+16 SET TEXT=OCXREC(D0,0)
SET SIZEC=SIZEC+$LENGTH(TEXT)
+17 IF '(TEXT["$$")
QUIT
+18 FOR PIEC=2:1:$LENGTH(TEXT,"$$")
Begin DoDot:3
+19 SET EFC=$PIECE($PIECE(TEXT,"$$",PIEC),"(",1)
+20 IF (EFC[" ")
SET EFC=$PIECE(EFC," ",1)
IF (EFC["^")
QUIT
IF '$LENGTH(EFC)
QUIT
+21 IF '$DATA(^TMP("OCXCMP",$JOB,"INCLUDE",EFC))
Begin DoDot:4
+22 DO WARN^OCXOCMPV("Unknown Local Extrinsic Function: "_EFC,$PIECE($TEXT(+1)," ",1))
QUIT
End DoDot:4
QUIT
+23 SET OCXEFC(EFC)=""
End DoDot:3
End DoDot:2
+24 ; ADJUST FOR SUBROUTINE DOCUMENTATION
SET SIZEC=SIZEC+100
+25 SET ^TMP("OCXCMP",$JOB,"C CODE",+CSUB,"SIZE")=SIZEC
+26 MERGE ^TMP("OCXCMP",$JOB,"C CODE",+CSUB,"CALLS")=OCXEFC
End DoDot:1
+27 ;
+28 IF $GET(DSUB)
IF $DATA(^TMP("OCXCMP",$JOB,"D CODE",+DSUB))
Begin DoDot:1
+29 IF $GET(^TMP("OCXCMP",$JOB,"D CODE",+DSUB,"SIZE"))
Begin DoDot:2
+30 SET SIZED=^TMP("OCXCMP",$JOB,"D CODE",+DSUB,"SIZE")
+31 IF $DATA(^TMP("OCXCMP",$JOB,"D CODE",+DSUB,"CALLS"))
Begin DoDot:3
+32 KILL OCXEFD
MERGE OCXEFD=^TMP("OCXCMP",$JOB,"D CODE",+DSUB,"CALLS")
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+33 ;
+34 KILL OCXEFF
MERGE OCXEFF=OCXEFC,OCXEFF=OCXEFD
+35 ;
+36 IF $DATA(OCXEFF)
SET EFC=""
FOR
SET EFC=$ORDER(OCXEFF(EFC))
IF '$LENGTH(EFC)
QUIT
IF 'OCXEFF(EFC)
Begin DoDot:1
+37 KILL OCXTEMP
+38 IF $DATA(^TMP("OCXCMP",$JOB,"INCLUDE",EFC,"SIZE"))
MERGE OCXTEMP("SIZE")=^TMP("OCXCMP",$JOB,"INCLUDE",EFC,"SIZE")
+39 IF $DATA(^TMP("OCXCMP",$JOB,"INCLUDE",EFC,"CALLS"))
MERGE OCXTEMP("CALLS")=^TMP("OCXCMP",$JOB,"INCLUDE",EFC,"CALLS")
+40 SET OCXEFF(EFC)=OCXTEMP("SIZE")
+41 IF '$DATA(OCXTEMP("CALLS"))
QUIT
+42 SET EFC=""
FOR
SET EFC=$ORDER(OCXTEMP("CALLS",EFC))
IF '$LENGTH(EFC)
QUIT
SET OCXEFF(EFC)=+$GET(OCXEFF(EFC))
End DoDot:1
+43 ;
+44 IF $DATA(OCXEFF)
SET EFC=""
FOR
SET EFC=$ORDER(OCXEFF(EFC))
IF '$LENGTH(EFC)
QUIT
SET SIZEF=SIZEF+OCXEFF(EFC)
+45 ;
+46 QUIT $GET(SIZEC)+$GET(SIZED)+$GET(SIZEF)
+47 ;
RNAM(X) ;
+1 NEW CHAR
+2 SET CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+3 QUIT "OCXOZ"_$EXTRACT(CHAR,(X\36+1))_$EXTRACT(CHAR,(X#36+1))
+4 ;
TODAY() NEW X,Y,%DT
SET X="T"
SET %DT=""
DO ^%DT
XECUTE ^DD("DD")
QUIT Y
+1 ;
NOW() NEW X,Y,%DT
SET X="N"
SET %DT="T"
DO ^%DT
XECUTE ^DD("DD")
IF (Y["@")
SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2,99)
QUIT Y
+1 ;
