1 | XBARRAY ; IHS/ADC/GTH - BUILD AN ARRAY ; [ 07/08/1999 3:54 PM ]
|
---|
2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
3 | ;
|
---|
4 | ; Thanks to Paul Wesley, DSD/OIRM, for the original
|
---|
5 | ; routine.
|
---|
6 | ;
|
---|
7 | ; This utility provides a word processing format of free
|
---|
8 | ; text and local variable references to build an array.
|
---|
9 | ;
|
---|
10 | ; A file is necessary that has a .01 field for the form
|
---|
11 | ; name and a WP field to hold the WP form.
|
---|
12 | ;
|
---|
13 | ; Please refer to routine XBFORM0 for documentation.
|
---|
14 | ;
|
---|
15 | Q
|
---|
16 | ;
|
---|
17 | GEN(XBFORM,XBWPDIC,XBWPFLD,XBREF,XBFMT,XBLAST) ;EP ** generate array
|
---|
18 | NEW XBLLINE
|
---|
19 | S XBLLINE=$G(XBLAST)
|
---|
20 | I $D(XBFORM(XBFORM)) D ZBUILD,REFBUILD,EXIT Q XBLLINE
|
---|
21 | D WPGET,BUILD,ZBUILD
|
---|
22 | D REFBUILD
|
---|
23 | D EXIT
|
---|
24 | Q XBLLINE
|
---|
25 | ;
|
---|
26 | EDIT(XBFORM,XBWPDIC,XBWPFLD) ;EP Edit a Form
|
---|
27 | EDIT2 ;
|
---|
28 | KILL XBFORM(XBFORM)
|
---|
29 | S XBLLINE=0,XBFMT=1
|
---|
30 | D EDITWP,WPGET,BUILD,ZBUILD
|
---|
31 | D ARRAY^XBLM("XBZ(",XBFORM)
|
---|
32 | I $$DIR^XBDIR("S^R:Re-Edit;Q:Quit")="R" KILL XBZ G EDIT2
|
---|
33 | D EXIT
|
---|
34 | KILL XBLLINE
|
---|
35 | Q
|
---|
36 | ;
|
---|
37 | EDITWP ;** edit WP array
|
---|
38 | KILL DIE,DIC,DA,DR
|
---|
39 | S DIC=XBWPDIC,DR=XBWPFLD,DIC(0)="AEQMLZ"
|
---|
40 | I $L($G(XBFORM)) S X=XBFORM,DIC(0)="XL"
|
---|
41 | D ^DIC
|
---|
42 | I Y'>0 S XBQUIT=1 Q
|
---|
43 | S DIE=$$DIC^XBDIQ1(XBWPDIC),DA=+Y,DR=XBWPFLD
|
---|
44 | D ^DIE
|
---|
45 | Q
|
---|
46 | ;
|
---|
47 | WPGET ;** get WP array
|
---|
48 | KILL XBWP,XBL,XBOUT,XBVAR,XBWWP,DIC,DR,DIE,DA
|
---|
49 | S X=XBFORM,DIC=XBWPDIC,DR=XBWPFLD,DIC(0)="X"
|
---|
50 | D ^DIC
|
---|
51 | I Y'>0 S XBWP(1)=XBFORM_" NOT FOUND",XBQUIT=1
|
---|
52 | S DA=+Y
|
---|
53 | D ENP^XBDIQ1(XBWPDIC,DA,XBWPFLD,"XBWWP(")
|
---|
54 | S %X="XBWWP("_XBWPFLD_",",%Y="XBWP("
|
---|
55 | D %XY^%RCR
|
---|
56 | KILL XBWWP
|
---|
57 | Q
|
---|
58 | ;
|
---|
59 | BUILD ;** scan WP array to build XBL
|
---|
60 | S XBWPL="",XBLINE=0
|
---|
61 | Q:$D(XBFORM(XBFORM))
|
---|
62 | F S XBWPL=$O(XBWP(XBWPL)) Q:XBWPL'>0 D LINE
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | LINE ;** process one line of the WP array
|
---|
66 | S Z=XBWP(XBWPL)
|
---|
67 | S XBLINE=XBLINE+1
|
---|
68 | F I=1:1:$L(Z) S A=$E(Z,I) D Q:$G(XBQUIT)
|
---|
69 | . I I=1,A="#" D MAP S I=$L(Z),XBLINE=XBLINE-1,XBQUIT=1 Q
|
---|
70 | . I I=1,A="*" D OUT S I=$L(Z),XBLINE=XBLINE-1,XBQUIT=1 Q
|
---|
71 | . I I=1,A=";" S I=$L(Z),XBLINE=XBLINE-1,XBQUIT=1 Q
|
---|
72 | . I A'=" ",A'="~" D TEXT Q
|
---|
73 | . I A="~" D VAR Q
|
---|
74 | .Q
|
---|
75 | KILL XBQUIT
|
---|
76 | Q
|
---|
77 | ;
|
---|
78 | ZBUILD ;** build Z array from XBL
|
---|
79 | KILL Z
|
---|
80 | I '$G(XBFMT) F XBL=1:1 D Q:('$O(XBFORM(XBFORM,XBL)))
|
---|
81 | . I '$D(XBFORM(XBFORM,XBL)),$O(XBFORM(XBFORM,XBL)) S XBZ(XBL+XBLLINE)=" " Q
|
---|
82 | . D FILL
|
---|
83 | .Q
|
---|
84 | I $G(XBFMT)=1 F XBL=1:1 D Q:('$O(XBFORM(XBFORM,XBL)))
|
---|
85 | . I '$D(XBFORM(XBFORM,XBL)),$O(XBFORM(XBFORM,XBL)) S XBZ(XBL+XBLLINE,0)=" " Q
|
---|
86 | . D FILL
|
---|
87 | .Q
|
---|
88 | Q
|
---|
89 | ;
|
---|
90 | REFBUILD ; %RCR BACK TO CALL
|
---|
91 | S %Y=XBREF,%X="XBZ("
|
---|
92 | D %XY^%RCR
|
---|
93 | S XBLLINE=XBLLINE+XBL
|
---|
94 | Q
|
---|
95 | ;
|
---|
96 | FILL ;** fill one line
|
---|
97 | S XBCOL=0,T=""
|
---|
98 | F S XBCOL=$O(XBFORM(XBFORM,XBL,XBCOL)) Q:XBCOL'>0 D
|
---|
99 | . S X=XBFORM(XBFORM,XBL,XBCOL),XBCOLX=XBCOL
|
---|
100 | . I XBCOL#1 S XBCOLX=XBCOL\1,X="S X="_X X X
|
---|
101 | . S XBXL=$L(X)
|
---|
102 | . Q:X=""
|
---|
103 | . S T=$$SETSTR^VALM1(X,T,XBCOLX,XBXL)
|
---|
104 | .Q
|
---|
105 | I T="" S XBLLINE=$G(XBLLINE)-1 Q
|
---|
106 | S:'$G(XBFMT) XBZ(XBL+XBLLINE)=T
|
---|
107 | S:($G(XBFMT)=1) XBZ(XBL+XBLLINE,0)=T
|
---|
108 | Q
|
---|
109 | ;
|
---|
110 | TEXT ;**
|
---|
111 | NEW W
|
---|
112 | S XBCOL=I
|
---|
113 | F W=I:1:$L(Z) S A=$E(Z,W) Q:A="~"
|
---|
114 | I W'=$L(Z) S W=W-1
|
---|
115 | S XBT=$E(Z,I,W),XBFORM(XBFORM,XBLINE,XBCOL)=XBT,I=W
|
---|
116 | Q
|
---|
117 | ;
|
---|
118 | VAR ;** add .5 to column count to indicate a variable vs text
|
---|
119 | S XBCOL=I
|
---|
120 | F W=I+1:1:$L(Z) S A=$E(Z,W) I A="~" Q
|
---|
121 | S XBT=$E(Z,I+1,W-1),XBFORM(XBFORM,XBLINE,XBCOL+.5)=XBT,I=W
|
---|
122 | I XBT'["|" D Q
|
---|
123 | . Q:'$D(XBOUT(XBT))
|
---|
124 | . S O=XBOUT(XBT),XBT=$P(O,"X")_XBT_$P(O,"X",2)
|
---|
125 | . S XBFORM(XBFORM,XBLINE,XBCOL+.5)=XBT
|
---|
126 | .Q
|
---|
127 | S XBV=$P(XBT,"|"),XBV=XBVAR(XBV),XBS=$P(XBT,"|",2)
|
---|
128 | I $L(XBS) S XBS="("_XBS_")"
|
---|
129 | S XBFORM(XBFORM,XBLINE,XBCOL+.5)=XBV_XBS
|
---|
130 | I $D(XBOUT(XBT)) D
|
---|
131 | . S O=XBOUT(XBT),XBT=XBV_XBS,XBT=$P(O,"X")_XBT_$P(O,"X",2)
|
---|
132 | . S XBFORM(XBFORM,XBLINE,XBCOL+.5)=XBT
|
---|
133 | .Q
|
---|
134 | Q
|
---|
135 | ;
|
---|
136 | MAP ;** map shorthand for variables
|
---|
137 | ;#xx1|yyy1*xx2|yyy2*
|
---|
138 | S Z=$E(Z,2,999)
|
---|
139 | I Z'["*" S XBVSUB=$P(Z,"|"),XBVAL=$P(Z,"|",2),XBVAR(XBVSUB)=XBVAL Q
|
---|
140 | F I=1:1 S P=$P(Z,"*",I) Q:P="" S XBVSUB=$P(P,"|"),XBVAL=$P(P,"|",2),XBVAR(XBVSUB)=XBVAL
|
---|
141 | Q
|
---|
142 | ;
|
---|
143 | OUT ;** output tranform of data field
|
---|
144 | ;*field|mumps output transform f(x)*
|
---|
145 | S Z=$E(Z,2,999)
|
---|
146 | I Z'["*" S XBVSUB=$P(Z,"!"),XBVAL=$P(Z,"!",2),XBOUT(XBVSUB)=XBVAL Q
|
---|
147 | F I=1:1 S P=$P(Z,"*",I) Q:P="" S XBVSUB=$P(P,"!"),XBVAL=$P(P,"!",2),XBOUT(XBVSUB)=XBVAL
|
---|
148 | Q
|
---|
149 | ;
|
---|
150 | TABS ;
|
---|
151 | W #
|
---|
152 | F %=0:1:7 W ?%*10,%*10
|
---|
153 | F %=1:1:66 W !?1,%,?3,"..^...." F X=1:1:7 W "|....^...."
|
---|
154 | Q
|
---|
155 | ;
|
---|
156 | EXIT ;
|
---|
157 | KILL %X,%Y,A,I,L,O,P,T,W,X
|
---|
158 | KILL XBZ,XBFMT,XBCOL,XBCOLX,XBF,XBL,XBLINE,XBLN,XBLOAD,XBOUT,XBQUIT,XBROU,XBS,XBT,XBTAG,XBTAGE,XBV,XBVAL,XBVAR,XBVSUB,XBWP,XBWPDA,XBWPDIC,XBWPFLD,XBWPL,XBWPNODE,XBWPSUB,XBWWP,XBX,XBXL
|
---|
159 | Q
|
---|
160 | ;
|
---|
161 | MDY(X) ;external date to mm/dd/yy x :: var or ~"NOW"~ or ~"TODAY"~
|
---|
162 | S %DT="TS"
|
---|
163 | D ^%DT
|
---|
164 | ;begin Y2K fix block
|
---|
165 | ;Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
|
---|
166 | Q $E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700) ;Y2000
|
---|
167 | ;end Y2K fix block
|
---|
168 | ;
|
---|
169 | WP(X) ;build wp entry X #:: WP(FLD,n)=TEXTn
|
---|
170 | NEW I,W
|
---|
171 | S XBLWP=$G(XBLLINE),W=$P(X,")")
|
---|
172 | F I=0:1 S X=$Q(@X) Q:X="" Q:(W'=$P(X,",")) D
|
---|
173 | . S T=@X,XBLLINE=XBLWP+I
|
---|
174 | . S:'$G(XBFMT) XBZ(XBL+XBLLINE)=T
|
---|
175 | . S:($G(XBFMT)=1) XBZ(XBL+XBLLINE,0)=T
|
---|
176 | Q ""
|
---|
177 | ;
|
---|