freem_fileman/USER/DDS11.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DDS11.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

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