Annotation of freem_fileman/USER/DDGFU.m, revision 1.1
1.1 ! snw 1: DDGFU ;SFISC/MKO-CALLED FROM THE FORMS ;09:50 AM 28 Sep 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;
! 5: VAL1 ;Data validation code
! 6: ;Form: DDS FIELD ADD
! 7: I $$GET^DDSVALF("BLOCK","DDGF FIELD ADD")]"",$$GET^DDSVALF("FIELD ORDER","DDGF FIELD ADD")]"",$$GET^DDSVALF("FIELD TYPE","DDGF FIELD ADD")]"" Q
! 8: ;
! 9: S DDGFT(1)=$C(7)_"Unable to save values."
! 10: S DDGFT(2)="All values must be filled in order to add a new field."
! 11: D HLP^DDSUTL(.DDGFT)
! 12: S DDSERROR=1
! 13: K DDGFT
! 14: Q
! 15: ;
! 16: DDCAP ;Caption, Post action on change
! 17: ;Form: DDGF FIELD DD
! 18: N DDGFOPG
! 19: S DDGFOPG=$$OTHPG
! 20: D:DDSOLD="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
! 21: ;
! 22: D:X="" CAPNULL(DDGFOPG)
! 23: D:X]"" UPDDC(DDGFOPG)
! 24: Q
! 25: ;
! 26: OTHPG() ;Return Other Parameters page#
! 27: N FLD,SUB,OPG
! 28: S FLD=$$GET^DDSVAL(.4044,.DA,4)
! 29: I FLD D
! 30: . S OPG=11
! 31: . S SUB=+$P($G(^DD(DDGFDD,FLD,0)),U,2)
! 32: . S:SUB OPG=$S(SUB_$P($G(^DD(SUB,.01,0)),U,2)'["W":21,1:31)
! 33: Q $G(OPG)
! 34: ;
! 35: ;
! 36: FOCAP ;Caption, Post action on change
! 37: ;Form: DDGF FIELD FORM ONLY
! 38: D:X'="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
! 39: ;
! 40: D:X="" CAPNULL(21)
! 41: D:X]"" UPDDC(21)
! 42: Q
! 43: ;
! 44: COMPCAP ;Caption, Post action on change
! 45: ;Form: DDGF FIELD COMPUTED
! 46: D:X'="!M" PUT^DDSVAL(.4044,.DA,1.1,"")
! 47: ;
! 48: D:X="" CAPNULL(11)
! 49: D:X]"" UPDDC(11)
! 50: Q
! 51: ;
! 52: CAPNULL(OPG) ;Caption changed to null
! 53: N DC,SC
! 54: ;
! 55: ;Clear suppress colon
! 56: S SC=$$GET^DDSVALF("SUPPRESS COLON AFTER CAPTION?")
! 57: D PUT^DDSVALF("SUPPRESS COLON AFTER CAPTION?","","","","I")
! 58: Q:'$G(OPG)
! 59: ;
! 60: ;Clear caption coordinates
! 61: D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,"")
! 62: ;
! 63: ;Move data to the left
! 64: S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
! 65: S $P(DC,",",2)=$P(DC,",",2)-$L(DDSOLD)-1-'SC
! 66: S:$P(DC,",",2)<1 $P(DC,",",2)=1
! 67: D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC,"I")
! 68: Q
! 69: ;
! 70: UPDDC(OPG) ;Update data coordinates
! 71: N DC,COL
! 72: S DC=$$GET^DDSVALF("DATA COORDINATE",1,OPG)
! 73: S COL=$P(DC,",",2),COL=COL+$L(X)-$L(DDSOLD)
! 74: I DDSOLD="" D
! 75: . D PUT^DDSVALF("CAPTION COORDINATE",1,OPG,DC,"I")
! 76: . S COL=COL+2
! 77: S:COL<1 COL=1
! 78: S $P(DC,",",2)=COL
! 79: D PUT^DDSVALF("DATA COORDINATE",1,OPG,DC)
! 80: Q
! 81: ;
! 82: POSTCH1 ;Field, Post Action On Change
! 83: ;Form: DDGF FIELD DD
! 84: ;
! 85: ;Determine new values for
! 86: ; a. caption (if caption is not !M)
! 87: ; b. caption coordinates (if ...)
! 88: ; c. data coordinates (if ...)
! 89: ; d. data length (kept within page boundaries)
! 90: ;
! 91: ;Input:
! 92: ; DDGFPG = Page number
! 93: ; DA(1) = Block #
! 94: ; DA = Field order number
! 95: ; X = Field number
! 96: ;
! 97: Q:X=""
! 98: N FILE,FLD,DD,C,C0,CC,DC,SC,L,PLRC
! 99: ;
! 100: S FLD=X
! 101: S FILE=+$P(^DIST(.404,DA(1),0),U,2) Q:'FILE
! 102: S DD=$G(^DD(FILE,FLD,0)) Q:DD?."^"
! 103: ;
! 104: S (C,C0)=$$GET^DDSVALF("CAPTION",1,1)
! 105: I C'="!M" D
! 106: . S:C]"" CC=$$GET^DDSVALF("CAPTION COORDINATE",1,11)
! 107: . S DC=$$GET^DDSVALF("DATA COORDINATE",1,11)
! 108: ;
! 109: I $D(DDGFREF),$D(DDGFPG) S PLRC=$P($G(@DDGFREF@("F",DDGFPG)),U,4)
! 110: S PLRC=$S($G(PLRC)]"":PLRC-1,1:IOM-2)-$P($G(@DDGFREF@("F",DDGFPG,DA(1))),U,2)
! 111: S L=$$LENGTH(FILE,FLD) S:'L L=1
! 112: ;
! 113: I C'="!M",$P(DD,U)]"" D
! 114: . S C=$P(DD,U)
! 115: . I $P(DD,U,2),$P($G(^DD(+$P(DD,U,2),.01,0)),U,2)'["W" S C="Select "_C
! 116: . D PUT^DDSVALF("CAPTION",1,1,C)
! 117: . ;
! 118: . I C0="" D
! 119: .. S CC=DC
! 120: .. S $P(DC,",",2)=$P(DC,",",2)+2
! 121: .. D PUT^DDSVALF("CAPTION COORDINATE",1,11,CC)
! 122: . E Q:$P(CC,",")'=$P(DC,",")
! 123: . ;
! 124: . S $P(DC,",",2)=$P(DC,",",2)+$L(C)-$L(C0)
! 125: . S:$P(DC,",",2)<1 $P(DC,",",2)=1
! 126: . D PUT^DDSVALF("DATA COORDINATE",1,11,DC)
! 127: ;
! 128: I C0'="!M",$P(DC,",",2)-2+L>PLRC S L=PLRC-$P(DC,",",2)+2
! 129: D PUT^DDSVALF("DATA LENGTH",1,11,L)
! 130: Q
! 131: ;
! 132: HBVAL ;Validate header block
! 133: Q:X="" Q:'$O(@(DIE_DA_",40,""B"",X,"""")"))
! 134: S DDSERROR=1
! 135: D HLP^DDSUTL($C(7)_DDSEXT_" already exists on this page.")
! 136: Q
! 137: ;
! 138: LENGTH(DIFILE,DIFLD) ;Find the maximum length of field
! 139: ;Input:
! 140: ; DIFILE = File number
! 141: ; DIFLD = Field number
! 142: ;
! 143: N DD,DIIT,DILEN,DITYPE
! 144: S DILEN=""
! 145: S DD=$G(^DD(DIFILE,DIFLD,0)) Q:DD?."^" DILEN
! 146: S DITYPE=$P(DD,U,2),DIIT=$P(DD,U,5,999)
! 147: ;
! 148: I DIIT["$L(X)>" S DILEN=+$P($P(DIIT,"$L(X)>",2,999),"E")
! 149: E I DITYPE["N" S DILEN=+$P(DITYPE,"J",2)
! 150: E I DITYPE["P" S DILEN=$$LENGTH(+$P(DITYPE,"P",2),.01)
! 151: ;
! 152: E I DITYPE["S" D
! 153: . N DICODE,DICODEA,DIPC
! 154: . S DICODE=$P(DD,U,3)
! 155: . F DIPC=1:1 S DICODEA=$P(DICODE,";",DIPC) Q:DICODEA="" D
! 156: .. S DILEN=$$MAX(DILEN,$L($P(DICODEA,":")),$L($P(DICODEA,":",2)))
! 157: ;
! 158: E I DITYPE["D" D
! 159: . N DIDT
! 160: . S DIDT=$P($P(DIIT,"S %DT=""",2,999),"""")
! 161: . S DILEN=$S(DIDT["S"&(DIDT["T"):20,DIDT["T":17,1:11)
! 162: ;
! 163: E I DITYPE["V" D
! 164: . N DIL,DIX
! 165: . S DIX=0 F S DIX=$O(^DD(DIFILE,DIFLD,"V",DIX)) Q:'DIX D
! 166: .. Q:'$G(^DD(DIFILE,DIFLD,"V",DIX,0))
! 167: .. S DIL=$G(DIL)+1
! 168: .. S DIL(DIL)=$$LENGTH(+^DD(DIFILE,DIFLD,"V",DIX,0),.01)
! 169: . S DILEN=$G(DIL(1))
! 170: . F DIL=1:1:$G(DIL)-1 S DILEN=$$MAX(DIL(DIL),DIL(DIL+1))
! 171: ;
! 172: E I DITYPE D
! 173: . Q:$D(^DD(+DITYPE,.01,0))[0
! 174: . S DILEN=$S($P(^DD(+DITYPE,.01,0),U,2)["W":1,1:$$LENGTH(+DITYPE,.01))
! 175: ;
! 176: Q DILEN
! 177: ;
! 178: MAX(X,Y,Z) ;Return the maximum of two or three numbers
! 179: N M
! 180: S M=$S(X>Y:+X,1:+Y),M=$S(M>$G(Z):M,1:+$G(Z))
! 181: Q M
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDGFU.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