Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (14 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • FOIAVistA/tag/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

    r628 r636  
    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
     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
    76 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=""
     7INDCK S %ZISY=""
    148 I "IOEFLD^IOSTBM"[%ZISFN S @%ZISFN=%ZISXX Q
    159 I %ZISXX]"" S @("%ZISY="_%ZISXX)
     
    1812 E  S @("IO"_$E(%ZISFN,1,6))=%ZISY
    1913 Q:'$D(%ZIS)#2  Q:%ZIS'["I"  Q:'$D(%ZISZ(%ZISFN,1))
    20  ;
    21 SRAY ;
    22  S %=%ZISY,%ZISY=$A($E(%ZISY,1))
     14SRAY S %=%ZISY,%ZISY=$A($E(%ZISY,1))
    2315 F %1=2:1:$L(%) S %ZISY=%ZISY_$S($A(%,%1)<32:$A(%,%1),$A(%,%1)=127:127,1:$E(%,%1))
    2416 S IOIS(%ZISY)=%ZISFN
    2517 Q
    2618CHECK ;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
     19 S %ZISXX=X D L S X=%ZISYY K %ZISXX,%ZISYY,%ZISI,%ZISNP,%ZISX1,%ZISX2,ZISCH,ZISNUM,ZISQ,ZISXL,ZISXLN
    2920 Q
    3021CHECK1 ;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
    3222 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)
     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
    3424 Q
    3525FORM ;Entry point called from input transforms of fields in DEV/TT files.
    3626 Q:$L(X,"_")'>1
    37  N %ZISSI,%ZISSY ;p440
    3827 ;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
    3928 S %ZISSY=""
    4029 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
     30 S X=%ZISSY K %ZISSI,%ZISSY
    4231 Q
    4332 ;
    4433L 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
     34 S (ZISXL)=0,%ZISYY="" F %ZISI=0:0 S ZISXL=ZISXL+1 S ZISCH=$E(%ZISXX,ZISXL) D L1 Q:ZISXL'<ZISXLN
    4635 ;I $L(%ZISYY,"$C(")>2,%ZISYY[")_$C(" S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX Q
    4736 S %ZISXX=%ZISYY D L2,L3 S %ZISYY=%ZISXX
     
    5241 I ZISCH="*" D STAR Q
    5342 I ZISCH="(" D PAREN Q
    54  S %ZISYY=%ZISYY_ZISCH
     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
    5545 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)_")"
     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)_")"
    6347 Q
    6448STAR ;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
     
    6751QUOTE 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
    6852 Q
    69 DOLR ;Looking for $C.
     53DOLR ;LOOKING FOR $C.
    7054 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
     55 I "ACDEFJLNOPRSTV"[$E(%ZISXX,ZISXL+1)&($E(%ZISXX,ZISXL+2)="(") S %ZISYY=%ZISYY_"$"_$E(%ZISXX,ZISXL+1),ZISXL=ZISXL+2 D PAREN
    7356 Q
    74 PAREN S %ZISYY=%ZISYY_"(",ZISEND=")",%ZISNP=%ZISNP+1 D SCAN S %ZISNP=%ZISNP-1
    75  Q
     57PAREN S %ZISYY=%ZISYY_"(",ZISEND=")",%ZISNP=%ZISNP+1 D SCAN S %ZISNP=%ZISNP-1 Q
    7658SCAN F %ZISI=0:0 S ZISXL=ZISXL+1,ZISCH=$E(%ZISXX,ZISXL) D S1 Q:ZISXL'<ZISXLN!(ZISEND=ZISCH&(%ZISNP))
    7759 Q
     
    7961 I ZISCH="$" D DOLR Q
    8062 I ZISCH="(" D PAREN Q
    81  S %ZISYY=%ZISYY_ZISCH
    82  Q
     63 S %ZISYY=%ZISYY_ZISCH Q
    8364 ;
    8465S2 ;MERGE $C
Note: See TracChangeset for help on using the changeset viewer.