Return to DDSM.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDSM	;SFISC/MKO-MULTILINE ;01:34 PM  6 Oct 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: MNAV(FND)	;Navigate within repeating blocks
    5: 	;Returns FND if navigating to another field within the repeating
    6: 	;block
    7: 	N DDSCL,DDSDDO,DDSNR,DDSPDA,DDSSN,DDSSTL
    8: 	S DDSDDO=$P(DDSU("N"),U,$L($P("U^D^R^L^N",DDACT),U)+5)
    9: 	;
   10: 	S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2),DDSCL=$P(DDSREP,U,3)
   11: 	S DDSSN=$P(DDSREP,U,4),DDSNR=$P(DDSREP,U,5)
   12: 	;
   13: 	I $P(DDSDDO,",",2)="-1" D MUP Q
   14: 	I $P(DDSDDO,",",2)="+1" D MDN Q
   15: 	I DA S DDO=+DDSDDO,FND=1 Q
   16: 	Q
   17: 	;
   18: MUP	;Move up a line
   19: 	Q:DDSSN'>1
   20: 	S DDSSN=DDSSN-1
   21: 	I DDSCL>1 D
   22: 	. S DDSCL=DDSCL-1 D MDA
   23: 	E  D
   24: 	. S DDSSTL=DDSSTL-1
   25: 	. D MDA,DB^DDSR(DDSPG,DDSBK)
   26: 	Q
   27: 	;
   28: MDN	;Move down a line
   29: 	Q:'DA
   30: 	S DDSSN=DDSSN+1
   31: 	I DDSCL<DDSNR D
   32: 	. S DDSCL=DDSCL+1 D MDA
   33: 	E  D
   34: 	. S DDSSTL=DDSSTL+1
   35: 	. D MDA,DB^DDSR(DDSPG,DDSBK)
   36: 	Q
   37: 	;
   38: MDA	;Update DDO, DA and Dn, set FND=1
   39: 	N DDSDASV
   40: 	S $P(DDSREP,U,2,4)=DDSSTL_U_DDSCL_U_DDSSN
   41: 	S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
   42: 	S DDSDASV=DDSDA
   43: 	S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
   44: 	S DA=+DDSDA,@("D"_DDSDL)=DA
   45: 	S DDO=$S(DA:+DDSDDO,1:$P(DDSREP,U,8))
   46: 	S FND=1
   47: 	Q
   48: 	;
   49: SEL	;Issue read
   50: 	N DIRUT
   51: 	S DIR(0)="PO"_DIE_":QEMZ"_$E("L",'$D(DDSTP)&'$P(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,2),U,4))
   52: 	I $P(DDSREP,U,7) D
   53: 	. S:$D(@(DIE_"0)"))[0 @(DIE_"0)")=U_$P(^DD($P(DDSREP,U,6),$P(DDSREP,U,7),0),U,2)_U_U
   54: 	E  D
   55: 	. S DIR("S")="I $D("_DIE_""""_$P(DDSREP,U,9)_""","_+$P(DDSREP,U)_",Y))"
   56: 	D ^DIR K DIR,DUOUT,DIROUT Q:DIR0N!$D(DIRUT)
   57: 	;
   58: 	S DA=+Y,$P(DDSDA,",")=DA
   59: 	I $P(Y,U,3)=1 D
   60: 	. N DDSFN,DDSLN,DDSPDA,DDSSN
   61: 	. S DDSPDA=$P(DDSREP,U),DDSLN=$P(DDSREP,U,3),DDSSN=$P(DDSREP,U,4)
   62: 	. D ADD(DDSDA,DDSPDA,DDSSN)
   63: 	. S DDSFN="F"_$P(@DDSREFS@(DDSPG,DDSBK),U,3)
   64: 	. D DMULT1^DDSR(DDSPG,DDSBK,DDSFN,DDSDA,DDSLN,DDSSN)
   65: 	. S DDSCHKQ=2
   66: 	E  D
   67: 	. S DDSCHKQ=1
   68: 	. D POSDA(DDSDA)
   69: 	;
   70: 	S Y=$P(Y,U)
   71: 	S:X="" Y=""
   72: 	Q
   73: 	;
   74: END	;
   75: 	S DDACT="N"
   76: 	Q:'DA
   77: 	D POSSN(999999999999)
   78: 	Q
   79: 	;
   80: PGDN	;Page down
   81: 	S DDACT="N"
   82: 	Q:'DA
   83: 	D POSSN($P(DDSREP,U,2)+$P(DDSREP,U,5))
   84: 	Q
   85: 	;
   86: PGUP	;Page up
   87: 	S DDACT="N"
   88: 	Q:$P(DDSREP,U,4)=1
   89: 	D POSSN($P(DDSREP,U,2)-$P(DDSREP,U,5))
   90: 	Q
   91: 	;
   92: POSSN(DDSSN)	;Make line with given DDSSN current
   93: 	N DDSLSN,DDSPDA,DDSSTL
   94: 	S DDSPDA=$P(DDSREP,U)
   95: 	S DDSLSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)+1
   96: 	S DDSSN=$$MIN(DDSLSN,DDSSN)
   97: 	S:DDSSN<1 DDSSN=1
   98: 	S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
   99: 	S DA=+DDSDA
  100: 	S DDSSTL=$P(DDSREP,U,2)
  101: 	;
  102: 	S:'DA DDO=$P(DDSREP,U,8)
  103: 	I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
  104: 	. S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
  105: 	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  106: 	E  D
  107: 	. S DDSSTL=$$MIN(DDSLSN-$P(DDSREP,U,5)+1,DDSSN)
  108: 	. S:DDSSTL<1 DDSSTL=1
  109: 	. S $P(DDSREP,U,2,4)=DDSSTL_U_(DDSSN-DDSSTL+1)_U_DDSSN
  110: 	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  111: 	. D DB^DDSR(DDSPG,DDSBK)
  112: 	Q
  113: 	;
  114: POSDA(DDSDA)	;Make line with given DDSDA current
  115: 	N DDSPDA,DDSSN,DDSSTL
  116: 	S DDSSN=@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B",DDSDA)
  117: 	S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2)
  118: 	;
  119: 	I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
  120: 	. N DY,DX
  121: 	. S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
  122: 	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  123: 	. S DY=$P(DIR0,U),DX=$P(DIR0,U,2) X IOXY W $J("",$P(DIR0,U,3))
  124: 	E  D
  125: 	. S $P(DDSREP,U,2,4)=DDSSN_"^1^"_DDSSN
  126: 	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  127: 	. D DB^DDSR(DDSPG,DDSBK)
  128: 	Q
  129: 	;
  130: ADD(DDSDA,DDSPDA,DDSSN)	;Add entry
  131: 	S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIE
  132: 	S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
  133: 	S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
  134: 	D ^DDS11(DDSBK)
  135: 	S DDSCHG=1
  136: 	Q
  137: 	;
  138: MIN(X,Y)	;
  139: 	Q $S(X<Y:X,1:Y)
  140: MAX(X,Y)	;
  141: 	Q $S(X>Y:X,1:Y)