Return to DDSZ1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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