Return to DDSZ2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSZ2	;SFISC/MKO-LOAD SCR, NAV, AND ORDER INFO ;11:01 AM  29 Jul 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EN(SC,N,O,RNAV)	;
    5: 	;Input:
    6: 	;  DDSPG
    7: 	;  DDSREFS
    8: 	;
    9: 	D SCR(.SC),NAV(.N),ORD(.O)
   10: 	D:$D(RNAV) RNAV(.RNAV,.O)
   11: 	Q
   12: 	;
   13: SCR(SC)	;Move image from SC to global
   14: 	N C,P,R,S
   15: 	Q:'$D(SC)
   16: 	S R=0 F  S R=$O(SC(R)) Q:'R  D
   17: 	. F C=1:1 Q:$E(SC(R),C)'=" "
   18: 	. S @DDSREFS@("X",DDSPG,R-1,C-1)=$TR($E(SC(R),C,999),$C(0)," ")
   19: 	. I $D(SC(R))=11 D
   20: 	.. S S="",P=0
   21: 	.. F  S P=$O(SC(R,P)) Q:'P  S S=S_(P-C+1)_";"_(SC(R,P)-C+1)_";U"_U
   22: 	.. S:S?.E1"^" S=$E(S,1,$L(S)-1)
   23: 	.. S:S]"" @DDSREFS@("X",DDSPG,R-1,C-1,"A")=S
   24: 	Q
   25: 	;
   26: NAV(N)	;
   27: 	N B,D1,D2,F,LN
   28: 	S N(9999,1)="0,0"
   29: 	;
   30: 	S D1="" F  S D1=$O(N(D1)) Q:D1=""  D
   31: 	. S D2="" F  S D2=$O(N(D1,D2)) Q:D2=""  D
   32: 	.. S F=$P(N(D1,D2),","),B=$P(N(D1,D2),",",2),LN=""
   33: 	.. D NAV1(.N,D1,D2,.LN)
   34: 	.. S @DDSREFS@(DDSPG,B,F,"N")=LN
   35: 	.. S:$D(DDSMUL(B,F)) $P(@DDSREFS@(DDSPG,B,F,"N"),U,11)=1
   36: 	Q
   37: 	;
   38: NAV1(N,D1,D2,LN)	;Setup "N" for navigation
   39: 	N E1,E2,I
   40: 	;
   41: 	S E1=$S($O(N(D1),-1)]"":$O(N(D1),-1),1:$O(N(""),-1))
   42: 	S E2=D2
   43: 	I $D(N(E1,E2))[0 S E2=$S($O(N(E1,E2),-1)]"":$O(N(E1,E2),-1),1:$O(N(E1,E2)))
   44: 	I E1]"",E2]"" S $P(LN,U)=N(E1,E2)
   45: 	;
   46: 	S E1=$S($O(N(D1))]"":$O(N(D1)),1:$O(N("")))
   47: 	S E2=D2
   48: 	I $D(N(E1,E2))[0 S E2=$S($O(N(E1,E2),-1)]"":$O(N(E1,E2),-1),1:$O(N(E1,E2)))
   49: 	I E1]"",E2]"" S $P(LN,U,2)=N(E1,E2)
   50: 	;
   51: 	S E1=D1,E2=$O(N(D1,D2))
   52: 	I E2="" S E1=$S($O(N(E1))]"":$O(N(E1)),1:$O(N(""))),E2=$O(N(E1,""))
   53: 	I E1]"",E2]"" S $P(LN,U,3)=N(E1,E2)
   54: 	;
   55: 	S E1=D1,E2=$S($O(N(E1,D2),-1)]"":$O(N(E1,D2),-1),1:"")
   56: 	I E2="" S E1=$S($O(N(E1),-1)]"":$O(N(E1),-1),1:$O(N(""),-1)),E2=$S($O(N(E1,""),-1)]"":$O(N(E1,""),-1),1:"")
   57: 	I E1]"",E2]"" S $P(LN,U,4)=N(E1,E2)
   58: 	;
   59: 	F I=1:1:4 S:$P($P(LN,U,I),",",2)=B!'$P($P(LN,U,I),",",2) $P(LN,U,I)=+$P(LN,U,I)
   60: 	Q
   61: 	;
   62: ORD(O)	;Setup field order info
   63: 	N B,BO,BP,F,FO,FP
   64: 	S (BO,FO)="" F  S BO=$O(O(BO)) Q:BO=""  S FO=$O(O(BO,"")) Q:FO]""
   65: 	S:FO="" BO=$O(O(""))
   66: 	S B=+$G(O(+BO)),F=+$G(O(+BO,+FO))
   67: 	S @DDSREFS@(DDSPG,"FIRST")=F_","_B
   68: 	;
   69: 	S (BP,FP)=0
   70: 	S BO="" F  S BO=$O(O(BO)) Q:BO=""  D
   71: 	. S B=+O(BO),F=0
   72: 	. S FO=$O(O(BO,"")) S:FO]"" F=O(BO,FO)
   73: 	. S $P(@DDSREFS@(DDSPG,B),U,9)=F
   74: 	. S:$P(O(BO),U,2)]"" $P(@DDSREFS@(DDSPG,B),U,10)=$S($P(O(BO),U,2)="FIRST":F,1:$P(O(BO),U,2))
   75: 	. S FO="" F  S FO=$O(O(BO,FO)) Q:FO=""  D
   76: 	.. S F=O(BO,FO)
   77: 	.. S $P(@DDSREFS@(DDSPG,BP,FP,"N"),U,5)=F_$S(B'=BP:","_B,1:"")
   78: 	.. S FP=F,BP=B
   79: 	S $P(@DDSREFS@(DDSPG,BP,FP,"N"),U,5)=0
   80: 	Q
   81: 	;
   82: RNAV(DDSRNAV,DDSO)	;Setup nav and fo info for rep blocks
   83: 	N DDSBO,DDSN,B,D1,D2,DN,F,F1,FO,LN,NX,RT
   84: 	S DDSBO="" F  S DDSBO=$O(DDSRNAV(DDSBO)) Q:DDSBO=""  D
   85: 	. ;N %X,%Y K DDSN S %X="DDSRNAV("_DDSBO_",",%Y="DDSN(" D %XY^%RCR
   86: 	. K DDSN M DDSN=DDSRNAV(DDSBO)
   87: 	. S D1="" F  S D1=$O(DDSN(D1)) Q:D1=""  D:$D(DDSN(D1))#2
   88: 	.. S B=DDSN(D1)
   89: 	.. S D2="" F  S D2=$O(DDSN(D1,D2)) Q:D2=""  D
   90: 	... S F=$P(DDSN(D1,D2),","),LN=""
   91: 	... D NAV1(.DDSN,D1,D2,.LN)
   92: 	... S $P(@DDSREFS@(DDSPG,B,F,"N"),U,6,9)=LN
   93: 	. ;
   94: 	. S B=+$G(DDSO(+DDSBO)) Q:'B
   95: 	. S FO=$O(DDSO(DDSBO,"")) Q:FO=""
   96: 	. S (F,F1)=DDSO(DDSBO,FO)
   97: 	. F  S FO=$O(DDSO(DDSBO,FO)) Q:FO=""  D
   98: 	.. S $P(@DDSREFS@(DDSPG,B,F,"N"),U,10)=DDSO(DDSBO,FO)
   99: 	.. S F=DDSO(DDSBO,FO)
  100: 	. S $P(@DDSREFS@(DDSPG,B,F,"N"),U,10)=F1_",+1"
  101: 	. ;
  102: 	. S DN=0
  103: 	. S F=0 F  S F=$O(@DDSREFS@(DDSPG,B,F)) Q:DN=2!(F="")  D
  104: 	.. S LN=$G(@DDSREFS@(DDSPG,B,F,"N")) Q:LN=""
  105: 	.. S RT=$P(LN,U,3),NX=$P(LN,U,5)
  106: 	.. S:RT[","!'RT DN=DN+1
  107: 	.. S:NX[","!'NX DN=DN+1
  108: 	. ;
  109: 	. S F=0 F  S F=$O(@DDSREFS@(DDSPG,B,F)) Q:F=""  D
  110: 	.. S $P(@DDSREFS@(DDSPG,B,F,"N"),U,3)=RT
  111: 	.. S $P(@DDSREFS@(DDSPG,B,F,"N"),U,5)=NX
  112: 	Q