Changeset 623 for 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
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
r613 r623 1 %ZISS1 ;AC/SFISC - Collect screen parameters 5/29/88 2:02 PM ;1/24/08 16:10 2 ;;8.0;KERNEL;**69,440**;JUL 10, 1995;Build 13 3 ;Per VHA Directive 2004-038, this routine should not be modified 4 VALID ; 5 N %ZISI,%ZISNP,ZISCH,ZISEND,ZISNUM,ZISQ,ZISXL,ZISXLN ;p440 6 D L 7 Q 8 ; 9 SET2 ; 10 S %ZISFN="" F %ZISZ=0:0 S %ZISFN=$O(%ZISZ(%ZISFN)) Q:%ZISFN="" I $D(%ZISZ(%ZISFN))#2 S %ZISXX=%ZISZ(%ZISFN) D INDCK 11 Q 12 INDCK ; 13 S %ZISY="" 14 I "IOEFLD^IOSTBM"[%ZISFN S @%ZISFN=%ZISXX Q 15 I %ZISXX]"" S @("%ZISY="_%ZISXX) 16 ;E S @("%ZISY="_"""""") 17 I $E(%ZISFN,1,2)="IO" S @%ZISFN=%ZISY 18 E S @("IO"_$E(%ZISFN,1,6))=%ZISY 19 Q:'$D(%ZIS)#2 Q:%ZIS'["I" Q:'$D(%ZISZ(%ZISFN,1)) 20 ; 21 SRAY ; 22 S %=%ZISY,%ZISY=$A($E(%ZISY,1)) 23 F %1=2:1:$L(%) S %ZISY=%ZISY_$S($A(%,%1)<32:$A(%,%1),$A(%,%1)=127:127,1:$E(%,%1)) 24 S IOIS(%ZISY)=%ZISFN 25 Q 26 CHECK ;Entry point called from input transforms of fields in DEV/TT files. 27 N %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN ;p440 28 S %ZISXX=X D L S X=%ZISYY 29 Q 30 CHECK1 ;Entry point called from input transforms of fields in DEV/TT files. 31 N %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN ;p440 32 S %ZISXX=$S(X?1"W ".E:$E(X,3,$L(X)),1:X) 33 D L S X=$S(X?1"W ".E:"W "_%ZISYY,1:%ZISYY) 34 Q 35 FORM ;Entry point called from input transforms of fields in DEV/TT files. 36 Q:$L(X,"_")'>1 37 N %ZISSI,%ZISSY ;p440 38 ;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 39 S %ZISSY="" 40 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:"_") 41 S X=%ZISSY 42 Q 43 ; 44 L S ZISQ="""",%ZISNP=0,ZISXLN=$L(%ZISXX) I 'ZISXLN S %ZISYY="" Q 45 S ZISXL=0,%ZISYY="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) D L1 Q:ZISXL'<ZISXLN 46 ;I $L(%ZISYY,"$C(")>2,%ZISYY[")_$C(" S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX Q 47 S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX 48 Q 49 L1 I ZISCH="_"!(ZISCH=",") S %ZISYY=%ZISYY_"_" Q 50 I ZISCH=ZISQ D QUOTE Q 51 I ZISCH="$" D DOLR Q 52 I ZISCH="*" D STAR Q 53 I ZISCH="(" D PAREN Q 54 S %ZISYY=%ZISYY_ZISCH 55 Q 56 L2 ;Find $C(x)_$C(y) and merge 57 N I ;p440 58 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 59 Q 60 L3 ; 61 N I 62 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)_")" 63 Q 64 STAR ;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 65 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 66 Q 67 QUOTE 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 68 Q 69 DOLR ;Looking for $C. 70 I "IXY"[$E(%ZISXX,ZISXL+1) S %ZISYY=%ZISYY_"$"_$E(%ZISXX,ZISXL+1) S ZISXL=ZISXL+1 Q 71 I "ACDEFJLNOPRSTV"[$E(%ZISXX,ZISXL+1)&($E(%ZISXX,ZISXL+2)="(") S %ZISYY=%ZISYY_"$"_$E(%ZISXX,ZISXL+1),ZISXL=ZISXL+2 D PAREN Q 72 S %ZISYY=%ZISYY_"$" ;p440 73 Q 74 PAREN S %ZISYY=%ZISYY_"(",ZISEND=")",%ZISNP=%ZISNP+1 D SCAN S %ZISNP=%ZISNP-1 75 Q 76 SCAN F %ZISI=0:0 S ZISXL=ZISXL+1,ZISCH=$E(%ZISXX,ZISXL) D S1 Q:ZISXL'<ZISXLN!(ZISEND=ZISCH&(%ZISNP)) 77 Q 78 S1 I ZISCH=ZISQ D QUOTE Q 79 I ZISCH="$" D DOLR Q 80 I ZISCH="(" D PAREN Q 81 S %ZISYY=%ZISYY_ZISCH 82 Q 83 ; 84 S2 ;MERGE $C 85 S %ZISX1=$E(%ZISX1,1,$L(%ZISX1)-1),%ZISX2=","_$E(%ZISX2,4,$L(%ZISX2)) 86 S $P(%ZISXX,"_",I,I+1)=%ZISX1_%ZISX2 87 N I D L2 88 Q 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 3 VALID D L K %ZISI,%ZISNP,ZISCH,ZISEND,ZISNUM,ZISQ,ZISXL,ZISXLN Q 4 ; 5 SET2 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 7 INDCK 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)) 14 SRAY 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 18 CHECK ;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 21 CHECK1 ;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 25 FORM ;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 ; 33 L 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 38 L1 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 44 L2 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 46 L3 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 48 STAR ;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 51 QUOTE 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 53 DOLR ;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 57 PAREN S %ZISYY=%ZISYY_"(",ZISEND=")",%ZISNP=%ZISNP+1 D SCAN S %ZISNP=%ZISNP-1 Q 58 SCAN F %ZISI=0:0 S ZISXL=ZISXL+1,ZISCH=$E(%ZISXX,ZISXL) D S1 Q:ZISXL'<ZISXLN!(ZISEND=ZISCH&(%ZISNP)) 59 Q 60 S1 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 ; 65 S2 ;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 TracChangeset
for help on using the changeset viewer.
