source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIKZ.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1DIKZ ;SFISC/XAK-XREF COMPILER ;7JUN2004
2 ;;22.0;VA FileMan;**140**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 I $G(DUZ(0))'="@" W $C(7),$$EZBLD^DIALOG(101) Q
5EN1 N DIKJ,%X D:'$D(DISYS) OS^DII
6 I '$D(^DD("OS",DISYS,"ZS")) W $C(7),$$EZBLD^DIALOG(820) Q
7 S U="^" S:'$G(DTIME) DTIME=300
8 D SIZ^DIPZ0(8036) G:$D(DTOUT)!($D(DUOUT))!('X) Q1 S DMAX=X
9FILE K DIC S DMAX=X,DIC="^DIC(",DIC(0)="AEQ" D ^DIC G Q1:Y'>0 N DIPZ S DIPZ=+Y
10 D RNM^DIPZ0(8036) G:$D(DTOUT)!($D(DUOUT))!(X="") Q1 S DNM=X
11 W ! S DIR(0)="Y",DIR("A")=$$EZBLD^DIALOG(8020) D ^DIR K DIR G:'Y!($D(DIRUT)) Q1
12 S X=DNM,Y=DIPZ K DIPZ
13EN ;
14 S Y(1)=$$EZBLD^DIALOG(8036),Y(3)=Y D BLD^DIALOG(8024,.Y,"","DIR") W:'$G(DIKZS) !!,DIR,! K Y(1),Y(3)
15 K ^UTILITY($J),^UTILITY("DIK",$J) N DIK,DIFILENO
16 S DNM=X,(DH,DIFILENO)=+Y I $D(^DIC(+Y,0,"GL")) S DIK2=^("GL")
17 I '$D(DIK2)!(DMAX<2400) G Q
18 S X=DH D A^DIU21,WAIT^DICD:'$G(DIKZS),DT^DICRW
19 S (DRN,DIKZQ,T)=0,DMAX=DMAX-100
20 ;
21 ;Load indexes defined in Index file
22 N DIXRLIST,DIKMF
23 K ^TMP("DIKC",$J)
24 D LOADALL^DIKC1(DIFILENO,"KS","R","",$NA(^TMP("DIKC",$J)),"",.DIKMF)
25 ;
26 ; compile kill logic
27 S (DIKA,A)=1,X=2,DIKVR="DIKILL",DIK=DIK2
28 D Q2,NEWR S ^UTILITY($J,0,3)=" S DIKZK="_X
29 S DIKGO="^"_DNM_1 ;starting ROUTINE name
30 D ^DIKZ0 G:DIKZQ Q D RTE
31 ;
32 ; compile set logic
33 S (DIKA,A)=1,X=1,DIKVR="DISET",DIK=DIK2
34 D Q2,NEWR S ^UTILITY($J,0,3)=" S DIKZK="_X
35 S DIKGO=DIKGO_",^"_DNM_DRN
36 D ^DIKZ0 G:DIKZQ Q D RTE
37 ;
38 ; compile driver code
39 D Q2,^DIKZ1
40 ;
41 ; finish up
42 S:'DIKZQ ^DD(DIFILENO,0,"DIKOLD")=DNM
43Q I DIKZQ S X=DH(1) D A^DIU21
44Q1 K DH,X,Y,DIK4,DIKQ,DIKC,T,DV,DIK8,DU,DW,DW1,DIKGO,DRN,DNM,DTOUT,DIRUT,DIROUT,DUOUT,DIC,A,%,%H,%Y
45 K DIKVR,DIK6,DIKA,DIKR,DMAX,DIK2,DIKCT,DIK1,DIK0,^UTILITY($J),^("DIK"),DIK,DIKZQ,DIKZZ,DIKZZ1,DIKZOVFL
46 K ^TMP("DIKC",$J)
47Q2 K DIKRT,DIKLW,DIKL2
48 Q
49SV ; transfer the accumulated code in ^UTILITY($J,#) to ^UTILITY($J,0,#)
50 ; (the routine buffer) and call SAVE to flush the buffer into a routine
51 ; whenever it's full. Flush the buffer one more time when done.
52 S DNM(1)=DNM_DRN
53 F DIKR=0:0 S DIKR=$O(^UTILITY($J,DIKR)) Q:DIKR'>0 S %=^(DIKR) K ^(DIKR) D:T+$L(%)>DMAX S ^UTILITY($J,0,DIKR)=%,T=T+$L(%)+2
54 . N DIKZMORE S DIKZMORE=1 D SAVE
55 D SAVE
56 Q
57SAVE ; save the accumulated code in ^UTILITY($J,0,#) as a routine
58 I DIKR,$E($P(%," ",2))="." F D Q:$E($P(%," ",2))'="."
59 . S ^UTILITY($J,DIKR)=%
60 . S DIKR=$O(^UTILITY($J,0,DIKR),-1),%=^(DIKR) K ^(DIKR)
61 I $D(DIKLW),'DIKR S ^UTILITY($J,0,997)=" G:'$D(DIKLM) "_$C(64+DIKCT)_$S(DNM_DRN'=DNM(1):"^"_DNM(1),1:"")_" Q:$D("_DIKVR_")"
62 I $D(DIKLW),DIKR S ^UTILITY($J,0,998)=" G ^"_DNM_(DRN+1)
63 S ^UTILITY($J,0,999)="END "_$S($D(DIKRT)&'DIKR:"Q",1:"G "_$S(DIKR&($D(DIKLW)):"END",1:"")_U_DNM_(DRN+1))
64 N X,DIR S X=DNM_DRN X ^DD("OS",DISYS,"ZS") S X(1)=X D BLD^DIALOG(8025,.X,"","DIR") W:'$G(DIKZS) !,DIR S:$G(DIKZRLA)]"" @DIKZRLA@(DNM_DRN)="",DIKZRLAF=1
65 D NEWR:'$D(DIKRT)!$G(DIKZMORE) Q:DIKZQ S ^DD(DH,0,"DIK")=DNM K DIKL2
66 Q
67NEWR ;
68 I '$D(DIKRT),T,$D(%),T+$L(%)>DMAX S DIKZDH=+$P(^UTILITY($J,0,1),"#",2)
69 K ^UTILITY($J,0) S DIKR=4,T=0,DRN=DRN+1 I $L(DNM_DRN)>8 W:'$G(DIKZS) $C(7),!,DNM_DRN_$$EZBLD^DIALOG(1503) S:$G(DIKZRLA)]"" DIKZRLAF=0 S DIKZQ=1 Q
70 S ^UTILITY($J,0,1)=DNM_DRN_" ; COMPILED XREF FOR FILE #"_$S($D(DIKZDH):DIKZDH,1:DH)_" ; "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),^(2)=" ; "
71 K DIKZDH Q
72RTE ;
73 N DIKFIL,DIKSUB,DIKLIST,DIKP
74 ;Build DIKSUB(file)=subfile1,subfile2,... list
75 S DIKFIL=0 F S DIKFIL=$O(DIK(X,DIKFIL)) Q:'DIKFIL D
76 . S DIKSUB=0 F S DIKSUB=$O(^DD(DIKFIL,"SB",DIKSUB)) Q:'DIKSUB D
77 .. S:$D(DIK(X,DIKSUB))#2 DIKSUB(DIKFIL)=$G(DIKSUB(DIKFIL))_DIKSUB_","
78 ;
79 ;Build DIKLIST(file)=subfile1,subfile2,...
80 M DIKLIST=DIKSUB
81 S DIKFIL=0 F S DIKFIL=$O(DIKSUB(DIKFIL)) Q:'DIKFIL D
82 . S DIKP=0
83 . F D Q:DIKP'<($L(DIKLIST(DIKFIL),",")-1)
84 .. F DIKP=DIKP+1:1:$L(DIKLIST(DIKFIL),",")-1 D
85 ... S DIKSUB=$P(DIKLIST(DIKFIL),",",DIKP)
86 ... S DIKLIST(DIKFIL)=DIKLIST(DIKFIL)_$G(DIKSUB(DIKSUB))
87 K DIKSUB
88 ;
89 ;Convert file numbers in DIKLIST to routine list
90 S DIKFIL=0 F S DIKFIL=$O(DIKLIST(DIKFIL)) Q:'DIKFIL D
91 . S $E(DIKLIST(DIKFIL),$L(DIKLIST(DIKFIL)))=""
92 . S DIKLIST(DIKFIL)=DIKFIL_","_DIKLIST(DIKFIL)
93 . F DIKP=1:1:$L(DIKLIST(DIKFIL),",") D
94 .. S DIKSUB=$P(DIKLIST(DIKFIL),",",DIKP)
95 .. S $P(DIKLIST(DIKFIL),",",DIKP)=DIK(X,DIKSUB)
96 ;
97 ;Move list to DIK
98 M DIK(X)=DIKLIST
99 K DIKFIL,DIKLIST,DIKP
100 S DIKRT=1,A=A-1,DH=DH(1) G SV
101 ;
102EN2(Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZZMSG) ;Silent or Talking with parameter passing
103 ;and optionally return list of routines built and if successful
104 ;FILE#,FLAGS,ROUTINE,RTNMAXSIZE,RTNLISTARRAY,MSGARRAY
105 ;Y=FILE NUMBER (required)
106 ;FLAGS="T"alk (optional)
107 ;X=ROUTINE NAME (required)
108 ;DMAX=ROUTINE SIZE (optional)
109 ;DIKZRLA=ROUTINE LIST ARRAY, by value (optional)
110 ;DIKZZMSG=MESSAGE ARRAY (optional) (default ^TMP)
111 ;*
112 ;DIKZS will be used to indicate "silent" if set to 1
113 ;Write statements are made conditional, if not "silent"
114 ;*
115 N DIKZS,DNM,DIQUIET,DIKZRIEN,DIKZRLAZ,%X,DIKJ,DIR,DIKZRLAF,DK1
116 N DIK,DIC,%I,DICS
117 S DIKZS=$G(DIKZFLGS)'["T"
118 S:DIKZS DIQUIET=1
119 I '$D(DIFM) N DIFM S DIFM=1 D
120 .N Y,DIKZFLGS,X,DMAX,DIKZRLA,DIKZS
121 .D INIZE^DIEFU
122 I $G(Y)'>0 D BLD^DIALOG(1700,"File Number missing or invalid") G EN2E
123 I '$D(^DD(Y,0)) D BLD^DIALOG(1700,"File Number: "_Y_" Invalid") G EN2E
124 I $G(X)']"" D BLD^DIALOG(1700,"Routine name missing") G EN2E
125 I X'?1U.NU&(X'?1"%"1U.NU) D BLD^DIALOG(1700,"Routine name invalid") G EN2E
126 I $L(X)>7 D BLD^DIALOG(1700,"Routine name too long") G EN2E
127 S DIKZRLA=$G(DIKZRLA,"DIKZRLAZ"),DIKZRIEN=Y
128 S:DIKZRLA="" DIKZRLA="DIKZRLAZ" S:$G(DMAX)<2500!($G(DMAX)>^DD("ROU")) DMAX=^DD("ROU")
129 S DIKZRLAF=""
130 K @DIKZRLA
131 D EN
132 G:'DIKZS!(DIKZRLAF) EN2E
133 D BLD^DIALOG(1700,"Compiling Cross-references (FILE#:"_DIKZRIEN_")"_$S(DIKZRLAF=0:", routine name too long",1:""))
134EN2E I 'DIKZS D MSG^DIALOG() Q
135 I $G(DIKZZMSG)]"" D CALLOUT^DIEFU(DIKZZMSG)
136 Q
137 ;
138 ;DIALOG #101 'only those with programmer's access'
139 ; #820 'no way to save routines on the system'
140 ; #8020 'Should the compilation run now?'
141 ; #8024 'Compiling template name Input template of file n'
142 ; #8036 'Cross-References'
143 ; #8025 'Routine filed'
144 ; #1503 'routine name is too long...'
Note: See TracBrowser for help on using the repository browser.