Return to DDS1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS1.m, revision 1.1.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