source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP8.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1OCXOCMP8 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Assemble Order Check Routines utilities) ;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 ;
5 Q
6FILE(RNUM) ;
7 ;
8 W:'$G(OCXAUTO) !,$$RNAM(RNUM)
9 N DIE,XCN,X
10 S DIE="^TMP(""OCXCMP"",$J,""D CODE"","_RNUM_",",XCN=0,X=$$RNAM(RNUM)
11 X ^%ZOSF("SAVE")
12 W:'$G(OCXAUTO) " ...",XCM," lines filed."
13 S OCXLCNT=$G(OCXLCNT)+XCM
14 Q
15 ;
16APPEND(DSUB,CSUB,SRC,LABEL) ;
17 ;
18 N OCXSRC,OCXNDX,OCXNEXT,GLD,GLC
19 S GLD="^TMP(""OCXCMP"",$J,""D CODE"","_(+DSUB)_")"
20 I (CSUB="$") D Q
21 .S OCXNEXT=$O(@GLD@(" "),-1)+1
22 .S @GLD@(OCXNEXT,0)="$"
23 .S OCXNEXT=$O(@GLD@(" "),-1)+1
24 .S @GLD@(OCXNEXT,0)=""
25 ;
26 I (SRC="C") M GLC=^TMP("OCXCMP",$J,"C CODE",+CSUB) S ^TMP("OCXCMP",$J,"D CODE","LINE",LABEL)=DSUB_","_($O(@GLD@(" "),-1)+1)
27 I (SRC="F") M GLC=^TMP("OCXCMP",$J,"INCLUDE",CSUB)
28 S OCXNDX=0 F S OCXNDX=$O(GLC(OCXNDX)) Q:'OCXNDX D
29 .S OCXNEXT=$O(@GLD@(" "),-1)+1
30 .S @GLD@(OCXNEXT,0)=GLC(OCXNDX,0)
31 M @GLD@("CALLS")=GLC("CALLS")
32 S @GLD@("SIZE")=$G(@GLD@("SIZE"))+$G(GLC("SIZE"))
33 Q
34 ;
35SIZE(DSUB,CSUB) ;
36 ;
37 N D0,EFC,OCXEFC,OCXEFD,OCXEFF,OCXREC
38 N OCXTEMP,PIEC,SIZEC,SIZED,SIZEF,TEXT
39 ;
40 S (SIZEC,SIZED,SIZEF)=0
41 K OCXEFF,OCXEFC,OCXEFD
42 S (OCXEFF,OCXEFC,OCXEFD)=""
43 ;
44 I $G(CSUB),$D(^TMP("OCXCMP",$J,"C CODE",+CSUB)) D
45 .I $D(^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")) D Q
46 ..S SIZEC=^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")
47 ..I $D(^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")) D
48 ...K OCXEFC M OCXEFC=^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")
49 .K OCXREC M OCXREC=^TMP("OCXCMP",$J,"C CODE",+CSUB)
50 .S D0=0 F S D0=$O(OCXREC(D0)) Q:'D0 D
51 ..S TEXT=OCXREC(D0,0),SIZEC=SIZEC+$L(TEXT)
52 ..Q:'(TEXT["$$")
53 ..F PIEC=2:1:$L(TEXT,"$$") D
54 ...S EFC=$P($P(TEXT,"$$",PIEC),"(",1)
55 ...S:(EFC[" ") EFC=$P(EFC," ",1) Q:(EFC["^") Q:'$L(EFC)
56 ...I '$D(^TMP("OCXCMP",$J,"INCLUDE",EFC)) D Q
57 ....D WARN^OCXOCMPV("Unknown Local Extrinsic Function: "_EFC,$P($T(+1)," ",1)) Q
58 ...S OCXEFC(EFC)=""
59 .S SIZEC=SIZEC+100 ; ADJUST FOR SUBROUTINE DOCUMENTATION
60 .S ^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")=SIZEC
61 .M ^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")=OCXEFC
62 ;
63 I $G(DSUB),$D(^TMP("OCXCMP",$J,"D CODE",+DSUB)) D
64 .I $G(^TMP("OCXCMP",$J,"D CODE",+DSUB,"SIZE")) D Q
65 ..S SIZED=^TMP("OCXCMP",$J,"D CODE",+DSUB,"SIZE")
66 ..I $D(^TMP("OCXCMP",$J,"D CODE",+DSUB,"CALLS")) D
67 ...K OCXEFD M OCXEFD=^TMP("OCXCMP",$J,"D CODE",+DSUB,"CALLS")
68 ;
69 K OCXEFF M OCXEFF=OCXEFC,OCXEFF=OCXEFD
70 ;
71 I $D(OCXEFF) S EFC="" F S EFC=$O(OCXEFF(EFC)) Q:'$L(EFC) I 'OCXEFF(EFC) D
72 .K OCXTEMP
73 .I $D(^TMP("OCXCMP",$J,"INCLUDE",EFC,"SIZE")) M OCXTEMP("SIZE")=^TMP("OCXCMP",$J,"INCLUDE",EFC,"SIZE")
74 .I $D(^TMP("OCXCMP",$J,"INCLUDE",EFC,"CALLS")) M OCXTEMP("CALLS")=^TMP("OCXCMP",$J,"INCLUDE",EFC,"CALLS")
75 .S OCXEFF(EFC)=OCXTEMP("SIZE")
76 .Q:'$D(OCXTEMP("CALLS"))
77 .S EFC="" F S EFC=$O(OCXTEMP("CALLS",EFC)) Q:'$L(EFC) S OCXEFF(EFC)=+$G(OCXEFF(EFC))
78 ;
79 I $D(OCXEFF) S EFC="" F S EFC=$O(OCXEFF(EFC)) Q:'$L(EFC) S SIZEF=SIZEF+OCXEFF(EFC)
80 ;
81 Q $G(SIZEC)+$G(SIZED)+$G(SIZEF)
82 ;
83RNAM(X) ;
84 N CHAR
85 S CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
86 Q "OCXOZ"_$E(CHAR,(X\36+1))_$E(CHAR,(X#36+1))
87 ;
88TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT X ^DD("DD") Q Y
89 ;
90NOW() 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
91 ;
Note: See TracBrowser for help on using the repository browser.