Return to DDSVAL.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSVAL	;SFISC/MKO-GET,PUT FOR DD IELDS ;01:27 PM  20 Oct 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: GET(DDSFILE,DA,DDSFLD,DDSER,DDSPARM)	;Get value for file/field
    6: 	N DDP,DIE,DDSANS,DDSTMP,X
    7: 	N DDSVDA,DDSVDDL0,DDSVDL,DDSVDV,DDSVND,DDSVPC
    8: 	K DIERR,^TMP("DIERR",$J)
    9: 	;
   10: 	S DDSANS=""
   11: 	I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"I"
   12: 	;
   13: 	D GDIE() G:$G(DIERR) GETQ
   14: 	;
   15: 	I DDSFLD[":",$$FIND^DDSLIB(DDSFLD,":") D  G GETQ
   16: 	. S DDSANS=$$REL^DDSVALM(DDP,.DA,DDSFLD,DDSPARM)
   17: 	;
   18: 	S DDSFLD=$$FIELD(DDP,DDSFLD) G:$G(DIERR) GETQ
   19: 	;
   20: 	S:$D(DDSREFT)#2 DDSTMP=$NA(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD))
   21: 	I $D(DDS),$D(DDSREFT)#2,$D(@DDSTMP@("D")) D
   22: 	. I $D(@DDSTMP@("M")),'^("M") D  Q
   23: 	.. S DDSANS=$NA(^TMP("DDSWP",$J,DDP,DDSVDA,DDSFLD))
   24: 	.. M @DDSANS=@DDSTMP@("D")
   25: 	. S DDSANS=$G(@DDSTMP@("D")) I DDSPARM["E",$D(^("X"))#2 S DDSANS=^("X")
   26: 	E  D
   27: 	. D GNDPC Q:$G(DIERR)
   28: 	. I DDSVPC=0,DDSVDV["W" D GETWP^DDSVALM Q
   29: 	. S DDSANS=$$GVAL(DIE,DA,DDSVND,DDSVPC)
   30: 	. I DDSPARM["E" S DDSANS=$$EXTERNAL^DILFD(DDP,DDSFLD,"",DDSANS)
   31: 	;
   32: GETQ	D:$G(DIERR) ERR^DDSVALM("$$GET^DDSVAL")
   33: 	Q DDSANS
   34: 	;
   35: PUT(DDSFILE,DA,DDSFLD,DDSVAL,DDSER,DDSPARM)	;Put value for file/field
   36: 	N DDP,DDSVDA,DDSV0,DDSV02,DDSVDL,DIE
   37: 	K DIERR,^TMP("DIERR",$J)
   38: 	;
   39: 	S:$D(DDSVAL)[0 DDSVAL=""
   40: 	I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"E"
   41: 	;
   42: 	D GDIE($D(DDS)#2) G:$G(DIERR) PUTQ G:'$G(DDSVDA) PUTQ
   43: 	S DDSFLD=$$FIELD(DDP,DDSFLD) G:$G(DIERR) PUTQ
   44: 	I DDSFLD=.01,"@"[DDSVAL D BLD^DIALOG(3086) G PUTQ
   45: 	;
   46: 	S DDSV0=^DD(DDP,DDSFLD,0),DDSV02=$P(DDSV0,U,2)
   47: 	I +DDSV02 D
   48: 	. D MULT^DDSVALM
   49: 	E  D VALPUT
   50: 	;
   51: PUTQ	D:$G(DIERR) ERR^DDSVALM("PUT^DDSVAL")
   52: 	Q
   53: 	;
   54: VALPUT	;Validate and put
   55: 	N DDSVY
   56: 	I DDSPARM["E" D
   57: 	. D VAL^DIE(DDP,DDSVDA,DDSFLD,"ER",DDSVAL,.DDSVY)
   58: 	E  D
   59: 	. D AUXVAL^DIEV(DDP,DDSVDA,DDSFLD,"EIR",DDSVAL,.DDSVY,DDSV0,DDSV02)
   60: 	Q:$G(DIERR)
   61: 	I DDSVY=DDSVY(0),'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD,"X")) K DDSVY(0)
   62: 	;
   63: 	I $D(DDS) D
   64: 	. S:'$D(@DDSREFT@("F"_DDP,DDSVDA,DDSFLD)) ^("GL")=DIE
   65: 	. D UPDATE(DDP,DDSVDA,.DA,DDSFLD,DDSPG,.DDSVY)
   66: 	. S DDSCHG=1
   67: 	E  D
   68: 	. N DDSFDA
   69: 	. S DDSFDA(DDP,DDSVDA,DDSFLD)=DDSVY
   70: 	. D FILE^DIE("","DDSFDA")
   71: 	Q
   72: 	;
   73: UPDATE(DDP,DDSVDA,DA,FLD,PG,Y)	;Store value, repaint
   74: 	N DX,DY,BK,DDO,LEN,EXT,PAGE,RJ,VAL
   75: 	S (EXT,@DDSREFT@("F"_DDP,DDSVDA,FLD,"D"))=Y,^("F")=3 S:$D(Y(0))#2 (EXT,^("X"))=Y(0)
   76: 	;
   77: 	D:FLD=.01
   78: 	. S PAGE=0 F  S PAGE=$O(@DDSREFS@("F"_DDP,FLD,"L",PAGE)) Q:'PAGE  D
   79: 	.. S BK=0 F  S BK=$O(@DDSREFS@("F"_DDP,FLD,"L",PAGE,BK)) Q:'BK  D
   80: 	... D:$P($G(@DDSREFS@(PAGE,BK)),U,8)
   81: 	.... N DDSPTB S DDSPTB=$G(@DDSREFS@(PAGE,BK,"PTB"))
   82: 	.... D:DDSPTB]"" RPF^DDS7(DDP,DDSPTB,DDSVDA,.DA)
   83: 	;
   84: 	S BK=0 F  S BK=$O(@DDSREFS@("F"_DDP,FLD,"L",PG,BK)) Q:'BK  D
   85: 	. S DDO=0 F  S DDO=$O(@DDSREFS@("F"_DDP,FLD,"L",PG,BK,DDO)) Q:'DDO  D
   86: 	.. S LEN=$G(@DDSREFS@(PG,BK,DDO,"D")) Q:LEN=""
   87: 	.. S DY=+LEN,DX=$P(LEN,U,2),RJ=$P(LEN,U,10),LEN=$P(LEN,U,3)
   88: 	.. S:$D(DDSREP)#2 DY=DY+$P(DDSREP,U,3)-1
   89: 	.. S VAL=$P(DDGLVID,DDGLDEL)_$E(EXT,1,LEN)_$P(DDGLVID,DDGLDEL,10)
   90: 	.. X IOXY
   91: 	.. W $S(RJ:$J("",LEN-$L(EXT))_VAL,1:VAL_$J("",LEN-$L(EXT)))
   92: 	;
   93: 	D:$D(@DDSREFS@("PT",DDP,FLD)) RPB^DDS7(DDP,FLD,PG)
   94: 	D:$D(@DDSREFS@("COMP",DDP,FLD,PG)) RPCF^DDSCOMP(PG)
   95: 	Q
   96: 	;
   97: GDIE(DDSVL)	;In:
   98: 	;  DDSFILE = File # or root
   99: 	;  DA      = Record array
  100: 	;  DDSVL   = Flag to lock record
  101: 	;Returns:
  102: 	;  DIE    = Global root of file
  103: 	;  DDP    = File #
  104: 	;  DDSVDL = Level #
  105: 	;  DDSVDA = DA,DA(1),...,
  106: 	S DDP=$S(DDSFILE=+DDSFILE:DDSFILE,1:+$P($G(@(DDSFILE_"0)")),U,2))
  107: 	I DDP=0 D BLD^DIALOG(202,"file") Q
  108: 	D GL^DDS10(DDP,.DA,.DIE,.DDSVDL,.DDSVDA,$G(DDSVL))
  109: 	Q
  110: 	;
  111: GNDPC	;In:
  112: 	;  DDP    = File #
  113: 	;  DDSFLD = Field #
  114: 	;Returns:
  115: 	;  DDSVDDL0 = 0 node of DD
  116: 	;  DDSVND   = Node where data resides
  117: 	;  DDSVPC   = Piece where data resides
  118: 	;  DDSVDV   = Field specifications
  119: 	;  X        = Pointed to file root or set of codes
  120: 	I $G(DDSFLD)="" D BLD^DIALOG(202,"field") Q
  121: 	S DDSVDDL0=$G(^DD(DDP,DDSFLD,0))
  122: 	I DDSVDDL0?."^" D  Q
  123: 	. N I,E
  124: 	. S (I("FILE"),E("FILE"))=DDP,I(1)="#"_DDSFLD,E("FIELD")=DDSFLD
  125: 	. D BLD^DIALOG(501,.I,.E)
  126: 	;
  127: 	S DDSVPC=$P(DDSVDDL0,U,4)
  128: 	S DDSVND=$P(DDSVPC,";"),DDSVPC=$P(DDSVPC,";",2)
  129: 	S DDSVDV=$P(DDSVDDL0,U,2),X=$P(DDSVDDL0,U,3)
  130: 	;
  131: 	N P S P("FILE")=DDP,P("FIELD")=DDSFLD
  132: 	I DDSVPC=" " D
  133: 	. D BLD^DIALOG(520,"computed",.P)
  134: 	I DDSVPC=0 D
  135: 	. S DDSVDV=+DDSVDV_$P($G(^DD(+DDSVDV,.01,0)),U,2)
  136: 	. D:DDSVDV'["W" BLD^DIALOG(520,"multiple",.P)
  137: 	Q
  138: 	;
  139: GVAL(DIE,DA,ND,PC)	;Get value
  140: 	N LN,Y
  141: 	S LN=$G(@(DIE_"DA,ND)"))
  142: 	I $E(PC)'="E" S Y=$P(LN,U,PC)
  143: 	E  S Y=$E(LN,+$E(PC,2,999),$P(PC,",",2)) S:Y?." " Y=""
  144: 	Q Y
  145: 	;
  146: FIELD(DDP,FLD)	;Get field number
  147: 	N F,P
  148: 	S:$E(FLD)="""" FLD=$$UQT^DDSLIB($E(FLD,1,$$AFTQ^DDSLIB(FLD)-1))
  149: 	;
  150: 	S F=FLD,P("FILE")=DDP
  151: 	I FLD'=+$P(FLD,"E") D  Q:$G(DIERR) ""
  152: 	. S F=$O(^DD(DDP,"B",FLD,""))
  153: 	. I F="" S P(1)=FLD D BLD^DIALOG(501,.P)
  154: 	;
  155: 	I $D(^DD(DDP,F,0))[0 S P(1)="#"_F D BLD^DIALOG(501,.P) Q ""
  156: 	Q F