Return to DDS4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDS4	;SFISC/MKO-FILE AND RELOAD ;08:31 AM  24 Oct 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	D ^DDS41 Q:Y'=1
    5: 	N DA,DDO,DIE,DDP,DDSDA
    6: 	;
    7: 	S DX=0,DY=IOSL-1 X IOXY W "Filing form"_$P(DDGLCLR,DDGLDEL)
    8: 	;
    9: 	;File data
   10: 	S DDS4FI="F"
   11: 	F  S DDS4FI=$O(@DDSREFT@(DDS4FI)) Q:DDS4FI'?1"F".E  D
   12: 	. S DDP=$E(DDS4FI,2,999)
   13: 	. S DDS4DA=" "
   14: 	. F  S DDS4DA=$O(@DDSREFT@(DDS4FI,DDS4DA)) Q:DDS4DA=""  D REC
   15: 	;
   16: 	;Reload all pages on form
   17: 	S DDS4P=0
   18: 	F  S DDS4P=$O(@DDSREFT@(DDS4P)) Q:'DDS4P  D
   19: 	. S DDS4B=0
   20: 	. F  S DDS4B=$O(@DDSREFT@(DDS4P,DDS4B)) Q:'DDS4B  D
   21: 	.. S DDP=$P(@DDSREFS@(DDS4P,DDS4B),U,3),DDSDA=" "
   22: 	.. F  S DDSDA=$O(@DDSREFT@(DDS4P,DDS4B,DDSDA)) Q:'DDSDA  D
   23: 	... S $P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U)=1,DIE=^(DDSDA,"GL")
   24: 	... Q:$P(@DDSREFT@(DDS4P,DDS4B,DDSDA),U,6)>1
   25: 	... D GDA(DDSDA)
   26: 	... D ^DDS11(DDS4B,1)
   27: 	;
   28: 	X:$G(^DIST(.403,+DDS,14))'?."^" ^(14)
   29: 	I '$G(DDSSAVE),$G(DDSPARM)["S" S DDSSAVE=1
   30: 	S (Y,DDSH)=1,(DDSCHG,DX)=0,DY=IOSL-1 X IOXY W $P(DDGLCLR,DDGLDEL)
   31: 	K @DDSREFT@("ADD")
   32: 	K DIC,DDS1B,DDS1DA,DDS4B,DDS4DA,DDS4FI,DDS4FLD,DDS4FO,DDS4P
   33: 	K DDSEXT,DDSI,DDSINT,DDSLC,DDSLN,DDSND,DDSOND,DDSOLD,DDSP,DDSPC
   34: 	K DDSW,DDSX,DV
   35: 	Q
   36: REC	;
   37: 	G:DDS4FI="F0" FORMONLY
   38: 	;
   39: 	S DIE=@DDSREFT@(DDS4FI,DDS4DA,"GL")
   40: 	D GDA(DDS4DA)
   41: 	S DDSOND=-1 K DDSLN
   42: 	S DDS4FLD=""
   43: 	F  S DDS4FLD=$O(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D FLD
   44: 	S:$D(DDSLN)#2 @(DIE_"DA,DDSND)")=DDSLN
   45: 	Q
   46: FLD	;
   47: 	Q:'$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F"))  S ^("F")=""
   48: 	I '$G(DDSCHANG),$G(DDSPARM)["C" S DDSCHANG=1
   49: 	S DDSINT=$G(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
   50: 	;
   51: 	;Word processing fields (quit if multiple)
   52: 	I $D(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"))#2 D:'$P(^("M"),U)  Q
   53: 	. N FR,TO
   54: 	. S FR=$NA(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"D"))
   55: 	. S TO=U_$$CREF^DILF($P(@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"M"),U,2))
   56: 	. K @TO
   57: 	. M @TO=@FR
   58: 	. K @FR,@DDSREFT@(DDS4FI,DDS4DA,DDS4FLD,"F")
   59: 	;
   60: 	Q:$G(^DD(DDP,DDS4FLD,0))?."^"  S DDSND=$P(^(0),U,4)
   61: 	S DDSPC=$P(DDSND,";",2) Q:"0 "[DDSPC
   62: 	S DDSND=$P(DDSND,";")
   63: 	;
   64: 	I DDSOND'=DDSND D
   65: 	. S:$D(DDSLN)#2 @(DIE_"DA,DDSOND)")=DDSLN
   66: 	. S DDSLN=$G(@(DIE_"DA,DDSND)"))
   67: 	. S DDSOND=DDSND
   68: 	;
   69: 	I DDSPC D
   70: 	. S DDSOLD=$P(DDSLN,U,DDSPC)
   71: 	. S $P(DDSLN,U,DDSPC)=DDSINT
   72: 	E  D
   73: 	. S DDSW=$E(DDSPC,2,999),DDSP=$P(DDSW,",",2)+1
   74: 	. S DDSOLD=$E(DDSLN,+DDSW,DDSP-1)
   75: 	. S DDSX=$E(DDSLN,DDSP,999)
   76: 	. S DDSLN=$E(DDSLN,1,DDSW-1)_$J("",DDSW-1-$L(DDSLN))_DDSINT
   77: 	. S:DDSX'?." " DDSLN=DDSLN_$J("",DDSP-DDSW-$L(DDSINT))_DDSX
   78: 	;
   79: 	I $D(^DD(DDP,DDS4FLD,1))!($P(^(0),U,2)["a") D XR
   80: 	;
   81: 	Q
   82: XR	;
   83: 	N DG,DP,DDS4AUD1,DDS4AUD2,DIIX
   84: 	S DP=DDP,DDSOND=-1
   85: 	I $D(DDSLN)#2 S @(DIE_"DA,DDSND)")=DDSLN K DDSLN
   86: 	;
   87: 	I $P(^DD(DDP,DDS4FLD,0),U,2)["a" D
   88: 	. S (DDS4AUD1,DDS4AUD2)=1
   89: 	. I $G(^DD(DDP,DDS4FLD,"AUDIT"))["e",DDSOLD="" S DDS4AUD1=0
   90: 	;
   91: 	I DDSOLD]"" D
   92: 	. S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
   93: 	.. S DIC=DIE,X=DDSOLD
   94: 	.. X:$D(^DD(DDP,DDS4FLD,1,DG,2))#2 ^(2)
   95: 	. I $G(DDS4AUD2) S DG=1,X=DDSOLD,DIIX="2^"_DDS4FLD D AUDIT^DIET
   96: 	;
   97: 	I DDSINT]"" D
   98: 	. S DG=0 F  S DG=$O(^DD(DDP,DDS4FLD,1,DG)) Q:DG<1  D
   99: 	.. S DIC=DIE,X=DDSINT
  100: 	.. X:$D(^DD(DDP,DDS4FLD,1,DG,1))#2 ^(1)
  101: 	. I $G(DDS4AUD1) S DG=1,X=DDSINT,DIIX="3^"_DDS4FLD D AUDIT^DIET
  102: 	Q
  103: GDA(DDSDA)	;
  104: 	N I
  105: 	K DA S DA=$P(DDSDA,",")
  106: 	F I=2:1:$L(DDSDA,",")-1 S DA(I-1)=$P(DDSDA,",",I)
  107: 	Q
  108: 	;
  109: FORMONLY	;
  110: 	N X
  111: 	D GDA(DDS4DA)
  112: 	S DDS4FLD=""
  113: 	F  S DDS4FLD=$O(@DDSREFT@("F0",DDS4DA,DDS4FLD)) Q:DDS4FLD=""  D
  114: 	. Q:'$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"F"))
  115: 	. S DDS4FO=$P(DDS4FLD,","),DDS4B=$P(DDS4FLD,",",2)
  116: 	. S DDSOLD=$G(@DDSREFT@("F0",DDS4DA,DDS4FLD,"O")),X=$G(^("D")),DDSEXT=$G(^("X"),X)
  117: 	. X:$G(^DIST(.404,DDS4B,40,DDS4FO,23))'?."^" ^(23)
  118: 	. S ^("O")=@DDSREFT@("F0",DDS4DA,DDS4FLD,"D"),^("F")=""
  119: 	Q