Return to DDSZ1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDSZ1.m, revision 1.1

1.1     ! snw         1: DDSZ1  ;SFISC/MKO-GET BLOCK INFO,SCREEN IMAGE ;11:00 AM  27 Sep 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: EN(DDSPG,DDSBK,DDP,DDSBY,DDSBX,DDSBO,DDSTP,DDSREP,DDSNDD,DDSPGRP,DDSSCR,DDSNAV,DDSORD,DDSRNAV) ;
        !             5:        ;Input:
        !             6:        ;  DDSREFS = Global ref
        !             7:        ;Output:
        !             8:        ;  DDSSCR
        !             9:        ;  DDSNAV
        !            10:        ;  DDSORD
        !            11:        ;  DDSRNAV
        !            12:        ;
        !            13:        N Y
        !            14:        S:$G(DDSTP)="" DDSTP="e"
        !            15:        I DDSTP'="h",$G(DDSBO),$D(DDSORD(DDSBO))[0 D
        !            16:        . S DDSORD(DDSBO)=DDSBK
        !            17:        . S:$G(DDSREP)>1 $P(DDSORD(DDSBO),U,2)=$S($P(DDSREP,U,5)]"":$P($$GETFLD^DDSLIB($P(DDSREP,U,5),"","","","",DDSBK),","),1:"FIRST")
        !            18:        ;
        !            19:        S DDSF=0
        !            20:        F  S DDSF=$O(^DIST(.404,DDSBK,40,DDSF)) Q:DDSF'=+DDSF  D FLD
        !            21:        ;
        !            22: KILL   K DDSC1,DDSC2,DDSCAP,DDSCLN,DDSD1,DDSD2,DDSD3
        !            23:        K DDSDDL0,DDSF,DDSFLD,DDSL0,DDSL01,DDSL2,DDSL4,DDSN
        !            24:        Q
        !            25:        ;
        !            26: FLD    ;Set up
        !            27:        ;  @DDSREFS@(pg,bk,ddo,
        !            28:        ;    "D")       = data $Y^data $X^data $L^field#
        !            29:        ;                  ^xcap $Y^xcap $X^xcap colon^xcap req
        !            30:        ;                  ^1 if computed field^1 if right justified
        !            31:        ;    "COMPE")   = M code that sets X
        !            32:        ;    "COMPE",1) = array sets DDSE(n)
        !            33:        ;
        !            34:        ;  @DDSREFS@("Ffile#",field#,"L",pg,bk,ddo)=""
        !            35:        ;
        !            36:        ;  DDSSCR(row)     = captions on that row
        !            37:        ;  DDSSCR(row,col) = final columns underlined
        !            38:        ;  DDSNAV(row,col) = ddo,bk for editable fields
        !            39:        ;  DDSORD(bo,fo)   = ddo for editable fields
        !            40:        ;
        !            41:        ;Get field properties
        !            42:        S DDSL0=$G(^DIST(.404,DDSBK,40,DDSF,0)),DDSL01=$G(^(.1)),DDSFLD=$S($P(DDSL0,U,3)=2:DDSF_","_DDSBK,1:+$G(^(1))),DDSL2=$G(^(2)),DDSL4=$G(^(4))
        !            43:        K:$P(DDSL0,U,3)=3!'$P(DDSL0,U,3) DDSNDD
        !            44:        S DDSDDL0=$G(^DD(DDP,DDSFLD,0)) Q:DDSL0?."^"!(DDSL2?."^")
        !            45:        S DDSD1=$P($P(DDSL2,U),",")+DDSBY-1
        !            46:        S DDSD2=$P($P(DDSL2,U),",",2)+DDSBX-1
        !            47:        S DDSD3=$P(DDSL2,U,2)
        !            48:        S DDSC1=$P($P(DDSL2,U,3),",")+DDSBY-1
        !            49:        S DDSC2=$P($P(DDSL2,U,3),",",2)+DDSBX-1
        !            50:        S DDSCAP=$TR($P(DDSL0,U,2)," ",$C(0))
        !            51:        S DDSCLN=$S(DDSCAP="":"",$P(DDSL0,U,3)=1:"",$P(DDSL2,U,4):"",1:":")
        !            52:        ;
        !            53:        I DDSC1'<0,DDSC2'<0,$L(DDSCAP)>0,DDSCAP'="!M" D
        !            54:        . ;Set CAP xref for ^-jumping
        !            55:        . I DDSTP="e","^2^3^"[(U_$P(DDSL0,U,3)_U)!'$P(DDSL0,U,3) D
        !            56:        .. N C,I
        !            57:        .. S I=0 F  S I=$O(DDSPGRP(I)) Q:'I  Q:U_DDSPGRP(I)_U[(U_DDSPG_U)
        !            58:        .. Q:'I
        !            59:        .. S C=$P(DDSL0,U,2)
        !            60:        .. S:C?1"Select ".E C=$P(C,"Select ",2,999)
        !            61:        .. S C=$E($TR(C,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"),1,63)
        !            62:        .. S @DDSREFS@("CAP",C,DDSPGRP(I),DDSPG,DDSBK,DDSF)=""
        !            63:        . ;
        !            64:        . ;Set DDSSCR
        !            65:        . I DDSC1'<0,DDSC2'<0,$L(DDSCAP)>0,DDSCAP'="!M" D
        !            66:        .. N DDSI,DDSX
        !            67:        .. S DDSX=DDSCAP_DDSCLN
        !            68:        .. F DDSI=1:1:+DDSREP D
        !            69:        ... S $E(DDSSCR(DDSC1+DDSI),DDSC2+1,DDSC2+$L(DDSX))=DDSX
        !            70:        ... S:$P(DDSDDL0,U,2)["R"!+DDSL4 DDSSCR(DDSC1+DDSI,DDSC2+1)=DDSC2+$L(DDSCAP)
        !            71:        ;
        !            72:        ;Set "D", "L" nodes, DDSNAV, and DDSORD
        !            73:        I DDSD1'<0,DDSD2'<0,DDSD3>0 D
        !            74:        . S @DDSREFS@(DDSPG,DDSBK,DDSF,"D")=DDSD1_U_DDSD2_U_DDSD3_U_DDSFLD
        !            75:        . S @DDSREFS@("F"_$S(DDSFLD[",":0,1:DDP),DDSFLD,"L",DDSPG,DDSBK,DDSF)=""
        !            76:        I DDSCAP="!M",DDSC1'<0,DDSC2'<0 S $P(@DDSREFS@(DDSPG,DDSBK,DDSF,"D"),U,5,8)=DDSC1_U_DDSC2_U_DDSCLN_U_($P(DDSDDL0,U,2)["R"!+DDSL4)
        !            77:        S:$P(DDSL4,U,3) $P(@DDSREFS@(DDSPG,DDSBK,DDSF,"D"),U,10)=1
        !            78:        ;
        !            79:        ;Computed fields
        !            80:        I $P(DDSL0,U,3)=4 D  K DDSCOMP,DDSAR,DDSEXP,DDSFD Q
        !            81:        . Q:$D(@DDSREFS@("COMPE",DDSBK,DDSF))
        !            82:        . S DDSCOMP=$G(^DIST(.404,DDSBK,40,DDSF,30)) Q:DDSCOMP?."^"
        !            83:        . D PARSE^DDSCOMP(DDP,DDSCOMP,DDSBK,.DDSEXP,.DDSAR,.DDSFD)
        !            84:        . Q:DDSEXP=""!$G(DIERR)
        !            85:        . S @DDSREFS@("COMPE",DDSBK,DDSF)=DDSEXP
        !            86:        . F DDSAR=1:1:DDSAR D
        !            87:        .. S:DDSAR(DDSAR)["*DDSREFC*" DDSAR(DDSAR)=$P(DDSAR(DDSAR),"*DDSREFC*")_$E(DDSREFS,1,$L(DDSREFS)-1)_",""COMPE"","_DDSBK_","_DDSF_","_DDSAR_$P(DDSAR(DDSAR),"*DDSREFC*",2,999)
        !            88:        .. S @DDSREFS@("COMPE",DDSBK,DDSF,DDSAR)=DDSAR(DDSAR)
        !            89:        .. I $D(DDSAR(DDSAR))>9 N I F I=1:1 Q:$D(DDSAR(DDSAR,I))[0  D
        !            90:        ... S @DDSREFS@("COMPE",DDSBK,DDSF,DDSAR,I)=DDSAR(DDSAR,I)
        !            91:        . S $P(@DDSREFS@(DDSPG,DDSBK,DDSF,"D"),U,9)=1
        !            92:        . I $G(DDSFD)]"" F DDSAR=1:1:$L(DDSFD,U) D
        !            93:        .. N F S F=$P(DDSFD,U,DDSAR) Q:F=""
        !            94:        .. S @DDSREFS@("COMP",$P(F,","),$P($P(F,",",2,99),";"),DDSPG,DDSBK,DDSF)=""
        !            95:        ;
        !            96:        Q:DDSD1<0!(DDSD2<0)!(DDSD3'>0)!(DDSL2?."^")
        !            97:        Q:$P(DDSDDL0,U,4)=" ; "  Q:DDSTP="h"  Q:DDSFLD=.001
        !            98:        I '$P(DDSDDL0,U,2),DDSTP'="e" Q
        !            99:        ;
        !           100:        S DDSORD(DDSBO,+DDSL0)=DDSF
        !           101:        S DDSNAV(DDSD1,DDSD2)=DDSF_","_DDSBK
        !           102:        S:$P(DDSDDL0,U,2) DDSMUL(DDSBK,DDSF)=""
        !           103:        ;
        !           104:        I $G(DDSREP)>1 D
        !           105:        . N I
        !           106:        . S DDSRNAV(DDSBO,DDSD1)=DDSBK
        !           107:        . S DDSRNAV(DDSBO,DDSD1,DDSD2)=DDSF
        !           108:        . S DDSRNAV(DDSBO,DDSD1-1,DDSD2)=DDSF_",-1"
        !           109:        . S DDSRNAV(DDSBO,DDSD1+1,DDSD2)=DDSF_",+1"
        !           110:        Q