source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOCMP8.m@ 1141

Last change on this file since 1141 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 3.6 KB
Line 
1OCXOCMP8 ;SLC/RJS,CLA - ORDER CHECK CODE COMPILER (Assemble Order Check Routines utilities) ;6:55 PM 24 Jan 2008
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997;Build 2
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 ; Modified from FOIA VISTA,
6 ; Copyright (C) 2007 WorldVistA
7 ;
8 ; This program is free software; you can redistribute it and/or modify
9 ; it under the terms of the GNU General Public License as published by
10 ; the Free Software Foundation; either version 2 of the License, or
11 ; (at your option) any later version.
12 ;
13 Q
14FILE(RNUM) ;
15 ;
16 W:'$G(OCXAUTO) !,$$RNAM(RNUM)
17 N DIE,XCN,X
18 S DIE="^TMP(""OCXCMP"",$J,""D CODE"","_RNUM_",",XCN=0,X=$$RNAM(RNUM)
19 X ^%ZOSF("SAVE")
20 ;
21 ; WVEHR/SO 01/24/08 ;Commented out next 2 lines
22 ; W:'$G(OCXAUTO) " ...",XCM," lines filed."
23 ; S OCXLCNT=$G(OCXLCNT)+XCM
24 ;
25 Q
26 ;
27APPEND(DSUB,CSUB,SRC,LABEL) ;
28 ;
29 N OCXSRC,OCXNDX,OCXNEXT,GLD,GLC
30 S GLD="^TMP(""OCXCMP"",$J,""D CODE"","_(+DSUB)_")"
31 I (CSUB="$") D Q
32 .S OCXNEXT=$O(@GLD@(" "),-1)+1
33 .S @GLD@(OCXNEXT,0)="$"
34 .S OCXNEXT=$O(@GLD@(" "),-1)+1
35 .S @GLD@(OCXNEXT,0)=""
36 ;
37 I (SRC="C") M GLC=^TMP("OCXCMP",$J,"C CODE",+CSUB) S ^TMP("OCXCMP",$J,"D CODE","LINE",LABEL)=DSUB_","_($O(@GLD@(" "),-1)+1)
38 I (SRC="F") M GLC=^TMP("OCXCMP",$J,"INCLUDE",CSUB)
39 S OCXNDX=0 F S OCXNDX=$O(GLC(OCXNDX)) Q:'OCXNDX D
40 .S OCXNEXT=$O(@GLD@(" "),-1)+1
41 .S @GLD@(OCXNEXT,0)=GLC(OCXNDX,0)
42 M @GLD@("CALLS")=GLC("CALLS")
43 S @GLD@("SIZE")=$G(@GLD@("SIZE"))+$G(GLC("SIZE"))
44 Q
45 ;
46SIZE(DSUB,CSUB) ;
47 ;
48 N D0,EFC,OCXEFC,OCXEFD,OCXEFF,OCXREC
49 N OCXTEMP,PIEC,SIZEC,SIZED,SIZEF,TEXT
50 ;
51 S (SIZEC,SIZED,SIZEF)=0
52 K OCXEFF,OCXEFC,OCXEFD
53 S (OCXEFF,OCXEFC,OCXEFD)=""
54 ;
55 I $G(CSUB),$D(^TMP("OCXCMP",$J,"C CODE",+CSUB)) D
56 .I $D(^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")) D Q
57 ..S SIZEC=^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")
58 ..I $D(^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")) D
59 ...K OCXEFC M OCXEFC=^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")
60 .K OCXREC M OCXREC=^TMP("OCXCMP",$J,"C CODE",+CSUB)
61 .S D0=0 F S D0=$O(OCXREC(D0)) Q:'D0 D
62 ..S TEXT=OCXREC(D0,0),SIZEC=SIZEC+$L(TEXT)
63 ..Q:'(TEXT["$$")
64 ..F PIEC=2:1:$L(TEXT,"$$") D
65 ...S EFC=$P($P(TEXT,"$$",PIEC),"(",1)
66 ...S:(EFC[" ") EFC=$P(EFC," ",1) Q:(EFC["^") Q:'$L(EFC)
67 ...I '$D(^TMP("OCXCMP",$J,"INCLUDE",EFC)) D Q
68 ....D WARN^OCXOCMPV("Unknown Local Extrinsic Function: "_EFC,$P($T(+1)," ",1)) Q
69 ...S OCXEFC(EFC)=""
70 .S SIZEC=SIZEC+100 ; ADJUST FOR SUBROUTINE DOCUMENTATION
71 .S ^TMP("OCXCMP",$J,"C CODE",+CSUB,"SIZE")=SIZEC
72 .M ^TMP("OCXCMP",$J,"C CODE",+CSUB,"CALLS")=OCXEFC
73 ;
74 I $G(DSUB),$D(^TMP("OCXCMP",$J,"D CODE",+DSUB)) D
75 .I $G(^TMP("OCXCMP",$J,"D CODE",+DSUB,"SIZE")) D Q
76 ..S SIZED=^TMP("OCXCMP",$J,"D CODE",+DSUB,"SIZE")
77 ..I $D(^TMP("OCXCMP",$J,"D CODE",+DSUB,"CALLS")) D
78 ...K OCXEFD M OCXEFD=^TMP("OCXCMP",$J,"D CODE",+DSUB,"CALLS")
79 ;
80 K OCXEFF M OCXEFF=OCXEFC,OCXEFF=OCXEFD
81 ;
82 I $D(OCXEFF) S EFC="" F S EFC=$O(OCXEFF(EFC)) Q:'$L(EFC) I 'OCXEFF(EFC) D
83 .K OCXTEMP
84 .I $D(^TMP("OCXCMP",$J,"INCLUDE",EFC,"SIZE")) M OCXTEMP("SIZE")=^TMP("OCXCMP",$J,"INCLUDE",EFC,"SIZE")
85 .I $D(^TMP("OCXCMP",$J,"INCLUDE",EFC,"CALLS")) M OCXTEMP("CALLS")=^TMP("OCXCMP",$J,"INCLUDE",EFC,"CALLS")
86 .S OCXEFF(EFC)=OCXTEMP("SIZE")
87 .Q:'$D(OCXTEMP("CALLS"))
88 .S EFC="" F S EFC=$O(OCXTEMP("CALLS",EFC)) Q:'$L(EFC) S OCXEFF(EFC)=+$G(OCXEFF(EFC))
89 ;
90 I $D(OCXEFF) S EFC="" F S EFC=$O(OCXEFF(EFC)) Q:'$L(EFC) S SIZEF=SIZEF+OCXEFF(EFC)
91 ;
92 Q $G(SIZEC)+$G(SIZED)+$G(SIZEF)
93 ;
94RNAM(X) ;
95 N CHAR
96 S CHAR="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
97 Q "OCXOZ"_$E(CHAR,(X\36+1))_$E(CHAR,(X#36+1))
98 ;
99TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT X ^DD("DD") Q Y
100 ;
101NOW() 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
102 ;
Note: See TracBrowser for help on using the repository browser.