source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZISS1.m@ 1800

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

revised back to 6/30/08 version

File size: 3.4 KB
Line 
1%ZISS1 ;AC/SFISC - Collect screen parameters 5/29/88 2:02 PM ;11/05/97 08:40
2 ;;8.0;KERNEL;**69**;JUL 10, 1995
3VALID D L K %ZISI,%ZISNP,ZISCH,ZISEND,ZISNUM,ZISQ,ZISXL,ZISXLN Q
4 ;
5SET2 S %ZISFN="" F %ZISZ=0:0 S %ZISFN=$O(%ZISZ(%ZISFN)) Q:%ZISFN="" I $D(%ZISZ(%ZISFN))#2 S %ZISXX=%ZISZ(%ZISFN) D INDCK
6 Q
7INDCK S %ZISY=""
8 I "IOEFLD^IOSTBM"[%ZISFN S @%ZISFN=%ZISXX Q
9 I %ZISXX]"" S @("%ZISY="_%ZISXX)
10 ;E S @("%ZISY="_"""""")
11 I $E(%ZISFN,1,2)="IO" S @%ZISFN=%ZISY
12 E S @("IO"_$E(%ZISFN,1,6))=%ZISY
13 Q:'$D(%ZIS)#2 Q:%ZIS'["I" Q:'$D(%ZISZ(%ZISFN,1))
14SRAY S %=%ZISY,%ZISY=$A($E(%ZISY,1))
15 F %1=2:1:$L(%) S %ZISY=%ZISY_$S($A(%,%1)<32:$A(%,%1),$A(%,%1)=127:127,1:$E(%,%1))
16 S IOIS(%ZISY)=%ZISFN
17 Q
18CHECK ;Entry point called from input transforms of fields in DEV/TT files.
19 S %ZISXX=X D L S X=%ZISYY K %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN
20 Q
21CHECK1 ;Entry point called from input transforms of fields in DEV/TT files.
22 S %ZISXX=$S(X?1"W ".E:$E(X,3,$L(X)),1:X)
23 D L S X=$S(X?1"W ".E:"W "_%ZISYY,1:%ZISYY) K %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN
24 Q
25FORM ;Entry point called from input transforms of fields in DEV/TT files.
26 Q:$L(X,"_")'>1
27 ;F %ZISSI=1:1:$L(X,"_") S %ZISX1=$P(X,"_",%ZISSI) I %ZISX1]"","#?!"[$E(%ZISX1) S X=$S(%ZISSI=1:"",1:$P(X,"_",1,%ZISSI-1)_",")_%ZISX1_$S(%ZISSI<$L(X,"_"):","_$P(X,"_",%ZISSI+1,255),1:"") W !,%ZISSI_"==>"_X
28 S %ZISSY=""
29 F %ZISSI=1:1:$L(X,"_") S %ZISSY=%ZISSY_$P(X,"_",%ZISSI)_$S($P(X,"_",%ZISSI+1)="":"","#?!"[$E($P(X,"_",%ZISSI+1)):",","#?!"[$E($P(X,"_",%ZISSI)):",",1:"_")
30 S X=%ZISSY K %ZISSI,%ZISSY
31 Q
32 ;
33L S ZISQ="""",%ZISNP=0,ZISXLN=$L(%ZISXX) I 'ZISXLN S %ZISYY="" Q
34 S (ZISXL)=0,%ZISYY="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) D L1 Q:ZISXL'<ZISXLN
35 ;I $L(%ZISYY,"$C(")>2,%ZISYY[")_$C(" S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX Q
36 S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX
37 Q
38L1 I ZISCH="_"!(ZISCH=",") S %ZISYY=%ZISYY_"_" Q
39 I ZISCH=ZISQ D QUOTE Q
40 I ZISCH="$" D DOLR Q
41 I ZISCH="*" D STAR Q
42 I ZISCH="(" D PAREN Q
43 S %ZISYY=%ZISYY_ZISCH Q
44L2 F I=1:1:$L(%ZISXX,"_") S %ZISX1=$P(%ZISXX,"_",I),%ZISX2=$P(%ZISXX,"_",I+1) I $E(%ZISX1,1,3)="$C(",$E(%ZISX2,1,3)="$C(" D S2
45 Q
46L3 F I=1:1:$L(%ZISXX,"_") I $P(%ZISXX,"_",I)["+","$("'[$E($P(%ZISXX,"_",I)),")"'[$E($P(%ZISXX,"_",I),$L($P(%ZISXX,"_",I))) S $P(%ZISXX,"_",I)="("_$P(%ZISXX,"_",I)_")"
47 Q
48STAR ;S ZISNUM="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) S:ZISCH?1N ZISNUM=ZISNUM_ZISCH I ZISCH=""!(ZISCH=",") S %ZISYY=%ZISYY_"$C("_+ZISNUM_")",ZISXL=ZISXL-1 Q
49 S ZISNUM="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) S:ZISCH'=""&(ZISCH'=",") ZISNUM=ZISNUM_ZISCH I ZISCH=""!(ZISCH=",") S %ZISYY=%ZISYY_"$C("_ZISNUM_")",ZISXL=ZISXL-1 Q
50 Q
51QUOTE S %ZISYY=%ZISYY_ZISCH F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL),%ZISYY=%ZISYY_ZISCH I ZISCH=ZISQ!(ZISXL'<ZISXLN) Q
52 Q
53DOLR ;LOOKING FOR $C.
54 I "IXY"[$E(%ZISXX,ZISXL+1) S %ZISYY=%ZISYY_"$"_$E(%ZISXX,ZISXL+1) S ZISXL=ZISXL+1 Q
55 I "ACDEFJLNOPRSTV"[$E(%ZISXX,ZISXL+1)&($E(%ZISXX,ZISXL+2)="(") S %ZISYY=%ZISYY_"$"_$E(%ZISXX,ZISXL+1),ZISXL=ZISXL+2 D PAREN
56 Q
57PAREN S %ZISYY=%ZISYY_"(",ZISEND=")",%ZISNP=%ZISNP+1 D SCAN S %ZISNP=%ZISNP-1 Q
58SCAN F %ZISI=0:0 S ZISXL=ZISXL+1,ZISCH=$E(%ZISXX,ZISXL) D S1 Q:ZISXL'<ZISXLN!(ZISEND=ZISCH&(%ZISNP))
59 Q
60S1 I ZISCH=ZISQ D QUOTE Q
61 I ZISCH="$" D DOLR Q
62 I ZISCH="(" D PAREN Q
63 S %ZISYY=%ZISYY_ZISCH Q
64 ;
65S2 ;MERGE $C
66 S %ZISX1=$E(%ZISX1,1,$L(%ZISX1)-1),%ZISX2=","_$E(%ZISX2,4,$L(%ZISX2))
67 S $P(%ZISXX,"_",I,I+1)=%ZISX1_%ZISX2
68 N I D L2
69 Q
Note: See TracBrowser for help on using the repository browser.