Annotation of freem_fileman/USER/DDSVAL.m, revision 1.1
1.1 ! snw 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSVAL.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER