Annotation of freem_fileman/DDSVALF.m, revision 1.1
1.1 ! snw 1: DDSVALF ;SFISC/MKO-GET,PUT VALUES FOR FORM ONLY FIELDS ;09:01 AM 12 Dec 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(DDSVFD,DDSVBK,DDSVPG,DDSPARM,DDSVDA) ;Get value
! 6: ;In: DDSPG = Current page
! 7: ; DDSBK = Current block
! 8: ; DDSPARM = "I" : internal, "E" : external form
! 9: ;
! 10: N DDSANS,DDSFLD,DDSVDDP
! 11: K DIERR,^TMP("DIERR",$J)
! 12: I $D(DDSPG)[0 N DDSPG S DDSPG=0
! 13: I $D(DDSBK)[0 N DDSBK S DDSBK=0
! 14: S DDSANS=""
! 15: I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"I"
! 16: ;
! 17: S DDSFLD=$P($$GETFLD^DDSLIB($G(DDSVFD),$G(DDSVBK),$G(DDSVPG),DDS,$G(DDSPG),$G(DDSBK),"F"),",",1,2)
! 18: G:$G(DIERR) GETQ
! 19: ;
! 20: S DDSVFD=+DDSFLD,DDSVBK=+$P(DDSFLD,",",2)
! 21: ;
! 22: S DDSVDDP=+$P($G(^DIST(.404,DDSVBK,0)),U,2)
! 23: I DDSVDDP,$G(DDSVDA)]"" N DDSDA S DDSDA=DDSVDA
! 24: E I DDSVDDP,DDSVBK'=DDSBK N DDSDA D GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
! 25: ;
! 26: I $D(@DDSREFT@("F0",DDSDA,DDSFLD,"D"))#2 S DDSANS=^("D") S:DDSPARM["E"&($D(^("X"))#2) DDSANS=^("X") G GETQ
! 27: ;
! 28: I "^1^3^"[(U_$P(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3)_U) D BLD^DIALOG(520,"DD or caption-only") G GETQ
! 29: ;
! 30: ;Form-only fields
! 31: I $P($G(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=2 D G:$G(DIERR) GETQ
! 32: . I $P($G(^DIST(.404,DDSVBK,40,DDSVFD,20)),U)="" D Q
! 33: .. N P S P(1)="READ TYPE",P(2)="FIELD multiple of the BLOCK"
! 34: .. D BLD^DIALOG(3011,.P)
! 35: . D:$D(^DIST(.404,DDSVBK,40,DDSVFD,3))#2 DEF(^(3),$G(^(3.1)),.DDSANS)
! 36: . S (@DDSREFT@("F0",DDSDA,DDSFLD,"D"),^("O"))=DDSANS
! 37: . I DDSANS]"" D
! 38: .. S:$D(DDSANS(0)) (DDSANS,@DDSREFT@("F0",DDSDA,DDSFLD,"X"))=$S($D(DDSANS(0,0))#2:DDSANS(0,0),1:DDSANS(0))
! 39: .. S $P(@DDSREFT@("F0",DDSDA,DDSFLD,"F"),U)=3,DDSCHG=1
! 40: ;
! 41: ;Computed fields
! 42: E S:$P($G(^DIST(.404,DDSVBK,40,DDSVFD,0)),U,3)=4 DDSANS=$$VAL^DDSCOMP(DDSVFD,DDSVBK,DDSDA)
! 43: ;
! 44: GETQ D:$G(DIERR) ERR^DDSVALM("$$GET^DDSVALF")
! 45: Q DDSANS
! 46: ;
! 47: PUT(DDSVFD,DDSVBK,DDSVPG,DDSVAL,DDSPARM,DDSVDA) ;Put value
! 48: N DIR,X,Y
! 49: N DDER,DDSFLD,DDSVDDP,DDSVX
! 50: K DIERR,^TMP("DIERR",$J)
! 51: I $D(DDSPG)[0 N DDSPG S DDSPG=0
! 52: I $D(DDSBK)[0 N DDSBK S DDSBK=0
! 53: S:$D(DDSVAL)[0 DDSVAL=""
! 54: I $G(DDSPARM)'["I",$G(DDSPARM)'["E" S DDSPARM=$G(DDSPARM)_"E"
! 55: ;
! 56: S DDSFLD=$$GETFLD^DDSLIB($G(DDSVFD),$G(DDSVBK),$G(DDSVPG),DDS,DDSPG,DDSBK,"F")
! 57: G:$G(DIERR) PUTQ
! 58: S DDSVFD=+DDSFLD,DDSVBK=+$P(DDSFLD,",",2),DDSVPG=$P(DDSFLD,",",3)
! 59: S DDSFLD=$P(DDSFLD,",",1,2)
! 60: ;
! 61: S DDSVDDP=+$P($G(^DIST(.404,DDSVBK,0)),U,2)
! 62: I DDSVDDP,$G(DDSVDA)]"" N DDSDA S DDSDA=DDSVDA
! 63: E I DDSVDDP,DDSVBK'=DDSBK N DDSDA D GL^DDS10(DDSVDDP,.DDSDAORG,"","",.DDSDA)
! 64: ;
! 65: ;
! 66: I $P(^DIST(.404,DDSVBK,40,DDSVFD,0),U,3)'=2 D BLD^DIALOG(520,"DD, computed, or caption-only") G PUTQ
! 67: ;
! 68: S DIR(0)=$P(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$P(^(20),U,2,3)
! 69: I DDSPARM["I",$E(DIR(0))="P"!(DIR(0)?1"DD".E) D
! 70: . N FIL,FLD
! 71: . S Y=DDSVAL
! 72: . I $E(DIR(0))="P" D
! 73: .. S FIL=+$P($G(@(U_$P($P(DIR(0),U,2),":")_"0)")),U,2) Q:'FIL
! 74: .. S Y(0)=$$EXTERNAL^DILFD(FIL,.01,"",Y)
! 75: . E D
! 76: .. N DV,I S FIL=$P($P(DIR(0),","),U,2),FLD=$P(DIR(0),",",2)
! 77: .. S DV=$P($G(^DD(FIL,FLD,0)),U,2)
! 78: .. F I="O","P","V","D","S" I DV[I S Y(0)=$$EXTERNAL^DILFD(FIL,FLD,"",Y) Q
! 79: E D G:$G(DDER) PUTQ
! 80: . I DDSVAL="" D Q
! 81: .. N DDSVREQ
! 82: .. S DDSVREQ=$P($G(@DDSREFT@(DDSVPG,DDSVBK,DDSVFD)),U)
! 83: .. S:DDSVREQ]"" DDSVREQ=$P($G(^DIST(.404,DDSVBK,40,DDSVFD,4)),U)
! 84: .. I DDSVREQ S DDER=1
! 85: .. E S Y=""
! 86: . S DIR("V")="",(X,DIR("B"))=DDSVAL
! 87: . S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
! 88: . I $P(DIR(0),U)["P",$P($P(DIR(0),U,2),":",2)'["Z" D
! 89: .. N I
! 90: .. S I=$P(DIR(0),U,2) Q:$P(I,":",2)["Z"
! 91: .. S $P(I,":",2)=$P(I,":",2)_"Z"
! 92: .. S $P(DIR(0),U,2)=I
! 93: . D ^DIR
! 94: . I $E($P(DIR(0),U))="P" S Y=$P(Y,U)
! 95: ;
! 96: ;Update ^TMP
! 97: S DDSCHG=1
! 98: S (DDSVX,@DDSREFT@("F0",DDSDA,DDSFLD,"D"))=Y,^("F")=3 S:$D(Y(0))#2 (DDSVX,^("X"))=$S($D(Y(0,0))#2:Y(0,0),1:Y(0)) I $D(^("X"))#2,Y="" S (DDSVX,^("X"))=""
! 99: ;
! 100: ;Repaint field if it appears on the current page
! 101: I $D(@DDSREFS@("F0",DDSFLD,"L",DDSPG,DDSVBK,DDSVFD))#2 D
! 102: . N DY,DX,DDSVL,DDSVRJ,DDSX
! 103: . S DY=+@DDSREFS@(DDSPG,DDSVBK,DDSVFD,"D"),DX=$P(^("D"),U,2),DDSVL=$P(^("D"),U,3),DDSVRJ=$P(^("D"),U,10)
! 104: . S:$D(DDSREP)#2 DY=DY+$P(DDSREP,U,3)-1
! 105: . S DDSX=$P(DDGLVID,DDGLDEL)_$E(DDSVX,1,DDSVL)_$P(DDGLVID,DDGLDEL,10)
! 106: . X IOXY
! 107: . W $S(DDSVRJ:$J("",DDSVL-$L(DDSVX))_DDSX,1:DDSX_$J("",DDSVL-$L(DDSVX)))
! 108: ;
! 109: D
! 110: . N DDP,DDSDA S DDP=0,DDSDA="0,"
! 111: . D:$D(@DDSREFS@("PT",DDP,DDSFLD)) RPB^DDS7(DDP,DDSFLD,DDSPG)
! 112: . D:$D(@DDSREFS@("COMP",DDP,DDSFLD,DDSPG)) RPCF^DDSCOMP(DDSPG)
! 113: ;
! 114: PUTQ D:$G(DIERR) ERR^DDSVALM("PUT^DDSVALF")
! 115: Q
! 116: ;
! 117: DEF(DDSLN3,DDSLN31,Y) ;Get default
! 118: N DDER,DIR,X
! 119: Q:DDSLN3=""
! 120: ;
! 121: I DDSLN3'="!M" S Y=DDSLN3
! 122: E I DDSLN31'?."^" X DDSLN31 S:$D(Y)[0 Y=""
! 123: Q:Y=""
! 124: ;
! 125: S DIR(0)=$P(^DIST(.404,DDSVBK,40,DDSVFD,20),U)_$P(^(20),U,2,3)
! 126: S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
! 127: S DIR("V")="",(X,DIR("B"))=Y
! 128: D ^DIR I DDER K Y S Y=""
! 129: ;
! 130: I Y]"",$E($P(DIR(0),U))="P" S Y=$P(Y,U)
! 131: Q
! 132: ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSVALF.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman