Return to DDS1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS1.m, revision 1.1

1.1     ! snw         1: DDS1(DDSPG)    ;SFISC/MKO-LOAD PAGE ;09:37 AM  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:        ;Input:
        !             5:        ;  DDS     = Form number^Form name
        !             6:        ;  DDSPG   = Internal page number
        !             7:        ;  DA      = Record array
        !             8:        ;  DDSREFT = Global location where data (temporarily) is stored
        !             9:        ;  DDP     = Primary file number of form
        !            10:        ;  DIE     = Global root of form
        !            11:        ;  DDSDA   = DA,DA(1),... of form
        !            12:        ;  DDSDL   = Level number
        !            13:        ;Also needed for pointed-to blocks:
        !            14:        ;  DDSDAORG
        !            15:        ;  DDSDLORG
        !            16:        ;Returns:
        !            17:        ;  DIERR
        !            18:        ;
        !            19:        S U="^"
        !            20:        ;
        !            21:        ;Get header block
        !            22:        S DDS1B=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U,2)
        !            23:        I DDS1B]"" D BLK(DDSPG,DDS1B,"",1) G:$G(DIERR) END
        !            24:        ;
        !            25:        ;Get all other blocks on page
        !            26:        S DDS1BO="" F  S DDS1BO=$O(^DIST(.403,+DDS,40,DDSPG,40,"AC",DDS1BO)) Q:DDS1BO=""  S DDS1B=$O(^(DDS1BO,0)) Q:'DDS1B  D BLK(DDSPG,DDS1B,DDS1BO) G:$G(DIERR) END
        !            27:        ;
        !            28: END    K DDS1B,DDS1BO
        !            29:        Q
        !            30:        ;
        !            31: BLK(DDSPG,DDS1B,DDS1BO,DDS1H,DDS1E)    ;Load block
        !            32:        ;In:  DDS1H  = 1 if a header block
        !            33:        ;     DDS1E  = 1 if we're loading up a pointed-to block and
        !            34:        ;              we want interactive dialog (DIC(0)["E") in the lookup
        !            35:        ;
        !            36:        I $D(^DIST(.404,DDS1B,0))[0 D BLD^DIALOG(3051,"#"_DDS1B) Q
        !            37:        ;
        !            38:        N DDS1PTB,DDS1REP S DDS1PTB=""
        !            39:        I '$G(DDS1H) D
        !            40:        . S DDS1PTB=$G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,1)),DDS1REP=$G(^(2))
        !            41:        . K:DDS1REP<2 DDS1REP
        !            42:        ;
        !            43:        I DDS1PTB]"" N @$$D0(DDSDL),DA,DDP,DIE,DDSDL,DDSDA D  Q:$G(DIERR)
        !            44:        . I $G(DDS1REP)>1 D
        !            45:        .. D BK^DDS10(.DDS1B,.DDP) Q:$G(DIERR)
        !            46:        .. D GDA^DDS10(DDS1B,$G(DDS1E),.DA) Q:$G(DIERR)
        !            47:        .. S DDP=$G(^DD(DDP,0,"UP"))
        !            48:        .. D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1)
        !            49:        .. D GETD0(.DA,DDSDL)
        !            50:        . E  D
        !            51:        .. D SET^DDS10(DDS1B,$G(DDS1E),.DA,.DDP,.DIE,.DDSDL,.DDSDA)
        !            52:        .. Q:$G(DIERR)
        !            53:        .. I DA="",'$G(DDS1E),$P($G(@DDSREFT@(DDSPG,DDS1B)),U)]"" S DDSDA=$P(^(DDS1B),U),DA=+DDSDA
        !            54:        .. S D0=DA
        !            55:        ;
        !            56:        I $G(DA)]"",$G(@DDSREFT@(DDSPG,DDS1B,DDSDA))<1 D
        !            57:        . S $P(@DDSREFT@(DDSPG,DDS1B,DDSDA),U)=1
        !            58:        . I $G(DDS1REP)>1 D REP Q
        !            59:        . ;
        !            60:        . S @DDSREFT@(DDSPG,DDS1B,DDSDA,"GL")=DIE
        !            61:        . D ^DDS11(DDS1B)
        !            62:        ;
        !            63:        S $P(@DDSREFT@(DDSPG,DDS1B),U)=$G(DDSDA)
        !            64:        Q
        !            65:        ;
        !            66: REP    ;Load data for repeating block
        !            67:        N DDS1DDP,DDS1IND,DDS1INI,DDS1MUL,DDS1PDA,DDS1REF,DDS1RT,DDS1SEL
        !            68:        N DDS1SN,DDS1VAL
        !            69:        S DDS1REF=$NA(@DDSREFT@(DDSPG,DDS1B))
        !            70:        S DDS1DDP=$P(@DDSREFS@(DDSPG,DDS1B),U,3)
        !            71:        S DDS1IND=$P(DDS1REP,U,2) S:DDS1IND="" DDS1IND="B"
        !            72:        S DDS1INI=$P(DDS1REP,U,3)
        !            73:        S DDS1SEL=$P(@DDSREFS@(DDSPG,DDS1B),U,10)
        !            74:        S DDS1PDA=DDSDA
        !            75:        ;
        !            76:        S DDS1MUL=$O(^DD(DDP,"SB",DDS1DDP,""))
        !            77:        ;
        !            78:        S $P(@DDS1REF@(DDS1PDA),U,7,10)=DDP_U_DDS1MUL_U_DDS1SEL_U_DDS1IND
        !            79:        S @DDS1REF@(DDSDA,"GL")=$S(DDS1MUL:DIE_+DA_","""_$P($P(^DD(DDP,DDS1MUL,0),U,4),";")_""",",1:^DIC(DDS1DDP,0,"GL"))
        !            80:        ;
        !            81:        N DIE,DDP
        !            82:        S DIE=@DDS1REF@(DDSDA,"GL"),DDS1RT=$$CREF^DILF(DIE),DDP=DDS1DDP
        !            83:        S DDS1SN=0
        !            84:        ;
        !            85:        I DDS1MUL D
        !            86:        . D DDA^DDS5(0,.DA,.DDSDL)
        !            87:        . S DDSDA=","_DDSDA
        !            88:        . S:'$D(@DDS1RT@(DDS1IND)) DDS1IND="!IEN"
        !            89:        . I DDS1IND="!IEN" D
        !            90:        .. S DA=0 F  S DA=$O(@DDS1RT@(DA)) Q:'DA  D REPLD
        !            91:        . E  D
        !            92:        .. S DDS1VAL=""
        !            93:        .. F  S DDS1VAL=$O(@DDS1RT@(DDS1IND,DDS1VAL)) Q:DDS1VAL=""  D
        !            94:        ... S DA="" F  S DA=$O(@DDS1RT@(DDS1IND,DDS1VAL,DA)) Q:DA=""  D REPLD
        !            95:        ;
        !            96:        E  S DDS1VAL=DA N D0,DA,DDSDA D
        !            97:        . S DDSDA=",",DA=""
        !            98:        . F  S DA=$O(@DDS1RT@(DDS1IND,DDS1VAL,DA)) Q:DA=""  D REPLD
        !            99:        ;
        !           100:        ;
        !           101:        I DDS1INI="l"!(DDS1INI="n") D
        !           102:        . N N,T
        !           103:        . S N=DDS1INI="n"
        !           104:        . S DDS1SN=$O(@DDS1REF@(DDS1PDA," "),-1)+N
        !           105:        . S T=DDS1SN-DDS1REP+2-N
        !           106:        . S DDS1INI=$S(T<1:1_U_DDS1SN,1:T_U_(DDS1REP-'N))_U_DDS1SN
        !           107:        E  S DDS1INI="1^1^1"
        !           108:        ;
        !           109:        S $P(@DDS1REF@(DDS1PDA),U,2,6)=DDS1PDA_U_DDS1INI_U_+DDS1REP
        !           110:        ;
        !           111:        I DDS1MUL D
        !           112:        . D UDA^DDS5(.DA,.DDSDL)
        !           113:        . S DDSDA=$P(DDSDA,",",2,999)
        !           114:        Q
        !           115:        ;
        !           116: REPLD  ;Load data
        !           117:        S DDS1SN=DDS1SN+1,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
        !           118:        S @DDS1REF@(DDS1PDA,DDS1SN)=DDSDA
        !           119:        S @DDS1REF@(DDS1PDA,"B",DDSDA)=DDS1SN
        !           120:        D ^DDS11(DDS1B)
        !           121:        Q
        !           122:        ;
        !           123: D0(DL) ;Given DL, return string D0,D1,...,Dn
        !           124:        N I,S
        !           125:        S S="" F I=0:1:DL S S=S_"D"_I_","
        !           126:        S:S?.E1"," S=$E(S,1,$L(S)-1)
        !           127:        Q S
        !           128:        ;
        !           129: GETD0(DA,DL)   ;Given DA array, set D0,D1...
        !           130:        N I
        !           131:        S @("D"_DL)=DA
        !           132:        F I=1:1:DL-1 S @("D"_(DL-I))=DA(I)
        !           133:        Q