- 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 ;
