Annotation of freem_fileman/DDS11.m, revision 1.1
1.1 ! snw 1: DDS11(DDSBK,DDSNFO) ;SFISC/MLH,MKO-LOAD DATA ;08:46 AM 24 Oct 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;Input variables:
! 5: ; DDSBK = Block #
! 6: ; DDSPG = Page # (needed for form-only fields)
! 7: ; DDSREFT = Temporary global location
! 8: ; DDP = File number of block
! 9: ; DIE = Global root of block
! 10: ; DDSDA = DA,DA(1),...
! 11: ; DDSNFO = Flag means don't reload form only fields
! 12: ;
! 13: N X,Y
! 14: S DDS1REFD=$NA(@DDSREFT@("F"_DDP,DDSDA))
! 15: ;
! 16: S DDS1FO=0
! 17: F S DDS1FO=$O(^DIST(.404,DDSBK,40,DDS1FO)) Q:'DDS1FO D LD
! 18: ;
! 19: I DDP,DDSDA S @DDS1REFD@("GL")=DIE
! 20: ;
! 21: K DDS1REFD,DDS1FLD,DDS1FO,DDS1LN,DDS1ND,DDS1PC,DDS1DV
! 22: K DDS1D1,DDS1D2,DDS1D3
! 23: Q
! 24: ;
! 25: LD ;Load data for a field
! 26: ;
! 27: ;Get form only fields
! 28: I $P($G(^DIST(.404,DDSBK,40,DDS1FO,0)),U,3)=2,$P($G(^(20)),U)]"" D Q
! 29: . Q:$G(DDSNFO)
! 30: . N DDP
! 31: . S DDP=0,DDS1FLD=DDS1FO_","_DDSBK
! 32: . Q:"^1^3^"[(U_$G(@DDSREFT@("F0",DDSDA,DDS1FLD,"F"))_U)
! 33: . S Y=""
! 34: . I $D(@DDSREFT@("F0",DDSDA,DDS1FLD,"F"))[0,$G(^DIST(.404,DDSBK,40,DDS1FO,3))]"" D DEF(^(3),$G(^(3.1)))
! 35: . S (@DDSREFT@("F0",DDSDA,DDS1FLD,"D"),^("O"))=Y
! 36: ;
! 37: ;Get DD fields
! 38: S DDS1FLD=$G(^DIST(.404,DDSBK,40,DDS1FO,1)) Q:DDS1FLD?."^"
! 39: Q:"^1^3^"[(U_$G(@DDS1REFD@(DDS1FLD,"F"))_U)
! 40: ;
! 41: S DDS1LN=$G(^DD(DDP,DDS1FLD,0)) Q:DDS1LN?."^"
! 42: S DDS1PC=$P(DDS1LN,U,4),DDS1ND=$P(DDS1PC,";"),DDS1PC=$P(DDS1PC,";",2)
! 43: S DDS1DV=$P(DDS1LN,U,2),X=$P(DDS1LN,U,3)
! 44: ;
! 45: D @($S(DDS1FLD=.001:"L3",DDS1PC=0:"L2",1:"L1"))
! 46: ;
! 47: I DDS1DV["O"!(DDS1DV["P")!(DDS1DV["V")!(DDS1DV["D")!(DDS1DV["S") D
! 48: . Q:$D(@DDS1REFD@(DDS1FLD,"X"))
! 49: . D:Y]"" XFORM
! 50: . S @DDS1REFD@(DDS1FLD,"X")=Y
! 51: ;
! 52: I DDS1PC=0,DDS1DV,DDS1DV'["W",$D(@DDS1REFD@(DDS1FLD,"X"))[0 S ^("X")=Y
! 53: Q
! 54: ;
! 55: L1 ;Get non-multiple field
! 56: S DDS1LN=$G(@(DIE_"DA,DDS1ND)"))
! 57: I $E(DDS1PC)'="E" S Y=$P(DDS1LN,U,DDS1PC)
! 58: E S Y=$E(DDS1LN,+$E(DDS1PC,2,999),$P(DDS1PC,",",2)) S:Y?." " Y=""
! 59: ;
! 60: K @DDS1REFD@(DDS1FLD,"X")
! 61: I Y="",$D(@DDS1REFD@(DDS1FLD,"F"))[0,$D(^DIST(.404,DDSBK,40,DDS1FO,3))#2 D DEF(^(3),$G(^(3.1)))
! 62: S @DDS1REFD@(DDS1FLD,"D")=Y
! 63: Q
! 64: ;
! 65: L2 ;Get multiple field
! 66: S DDS1SUB=+$P(DDS1LN,U,2) Q:$D(^DD(DDS1SUB,.01,0))[0
! 67: S DDS1DV=DDS1SUB_$P(^DD(DDS1SUB,.01,0),U,2),X=$P(^(0),U,3)
! 68: S DDS1DIC=DIE_DA_","""_DDS1ND_""","
! 69: ;
! 70: D:DDS1DV'["W"
! 71: . I $D(^DIST(.404,DDSBK,40,DDS1FO,3))#2 D D L22
! 72: .. D DEF(^DIST(.404,DDSBK,40,DDS1FO,3),$G(^(3.1)),1)
! 73: .. S DDS1RN=$S($G(Y)="FIRST":$O(@(DDS1DIC_"0)")),$G(Y)="LAST":$O(@(DDS1DIC_""" "")"),-1),1:+$G(Y))
! 74: . E I $D(DUZ)#2,$L(DDS1DIC)<29,$D(^DISV(DUZ,DDS1DIC))#2 S DDS1RN=^(DDS1DIC) D L22
! 75: . E S DDS1RN=$S($D(@(DDS1DIC_"0)"))#2:$P(^(0),U,3),1:$O(^(0))) D L22
! 76: . E S (Y,@DDS1REFD@(DDS1FLD,"D"))=""
! 77: ;
! 78: S @DDS1REFD@(DDS1FLD,"M")=$S(DDS1DV["W":0,1:1)_DDS1DIC_U_DDS1SUB
! 79: K DDS1DIC,DDS1RN,DDS1SUB
! 80: Q
! 81: L22 ;
! 82: I DDS1RN>0,$D(@(DDS1DIC_+DDS1RN_",0)"))#2 S Y=$P(^(0),U),@DDS1REFD@(DDS1FLD,"D")=+DDS1RN
! 83: Q
! 84: ;
! 85: DEF(DDS1LN3,DDS1LN31,DDS1MULT) ;Get default
! 86: N DDS1PTR,DDS1OT
! 87: Q:DDS1LN3=""
! 88: I DDS1LN3'="!M" S Y=DDS1LN3
! 89: E I DDS1LN31'?."^" X DDS1LN31 S:$D(Y)[0 Y=""
! 90: Q:Y=""!$G(DDS1MULT)
! 91: ;
! 92: K DIR
! 93: I DDS1FLD["," D
! 94: . S DIR(0)=$P(^DIST(.404,DDSBK,40,DDS1FO,20),U)_$P(^(20),U,2,3)
! 95: . S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
! 96: . I $E($P(DIR(0),U))="P" S DDS1PTR=1
! 97: E D
! 98: . S DIR(0)=DDP_","_DDS1FLD
! 99: . S DDS1PTR=$P($G(^DD(DDP,DDS1FLD,0)),U,2)
! 100: . S DDS1OT=DDS1PTR["O",DDS1PTR=DDS1PTR["P"
! 101: S DIR("V")="",(X,DIR("B"))=Y
! 102: D ^DIR
! 103: ;
! 104: I DDER S Y=""
! 105: I Y]"" D
! 106: . I $G(DDS1PTR) S Y=$P(Y,U)
! 107: . S $P(@DDSREFT@("F"_DDP,DDSDA,DDS1FLD,"F"),U)=3
! 108: . I $G(DDS1PTR),$G(DDS1OT),$D(^DD(DDP,DDS1FLD,2))#2 K Y(0),Y(0,0)
! 109: . S:$D(Y(0)) @DDSREFT@("F"_DDP,DDSDA,DDS1FLD,"X")=$S($D(Y(0,0))#2:Y(0,0),1:Y(0))
! 110: . S DDSCHG=1
! 111: K DDER,DIR
! 112: Q
! 113: ;
! 114: L3 ;Get number field
! 115: S (@DDS1REFD@(.001,"D"),Y)=DA
! 116: Q
! 117: ;
! 118: EXT(DDP,DDS1FLD,Y) ;Return external form of Y
! 119: N DDS1DV,X
! 120: S DDS1DV=$P(^DD(DDP,DDS1FLD,0),U,2),X=$P(^(0),U,3)
! 121: I DDS1DV'["O",DDS1DV'["P",DDS1DV'["V",DDS1DV'["D",DDS1DV'["S" Q Y
! 122: I DDS1DV'["O",Y="" Q ""
! 123: D XFORM
! 124: Q Y
! 125: ;
! 126: XFORM ;
! 127: N DDS1N
! 128: I DDS1DV["O",+DDS1FLD,$D(^DD(DDP,+DDS1FLD,2))#2 X ^(2) Q
! 129: I DDS1DV["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) Q:'$D(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),DDS1DV=$P(^(0),U,2) G XFORM
! 130: I DDS1DV["V",+$P(Y,"E"),$P(Y,";",2)["(",$D(@(U_$P(Y,";",2)_"0)"))#2 S X=+$P($P(^(0),U,2),"E") Q:$D(^(+$P(Y,"E"),0))[0 S Y=$P(^(0),U) I $D(^DD(+$P(X,"E"),.01,0))#2 S DDS1DV=$P(^(0),U,2),X=$P(^(0),U,3) G XFORM
! 131: I DDS1DV["D" X ^DD("DD")
! 132: I DDS1DV["S" S DDS1N=$P($P(";"_X,";"_Y_":",2),";",1) S:DDS1N]"" Y=DDS1N
! 133: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDS11.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman