Return to DDS1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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