Return to DIET.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIET	;SFISC/XAK-DISPLAY INPUT TEMPLATE ;2/18/93 17:02 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	I '$D(^DIE(D0,0)) S X="" Q
    5: 	S X=^(0),DL=1,DIFILE(DL)=$P(X,U,4),W="FIRST" G Q:'$D(^DD(DIFILE(DL),0))
    6: A	S DIPP(DL)=$S($D(^DIE(D0,"DR",DL,DIFILE(DL))):^(DIFILE(DL)),1:"ALL") F %A(DL)=1:1 S X=$P(DIPP(DL),";",%A(DL)) Q:X=""  D DJ
    7: 	S %(DL)=0 F  S %(DL)=$O(^DIE(D0,"DR",DL,DIFILE(DL),%(DL))) S:%(DL)="" %(DL)=-1 G UP:%(DL)'>0 S DIPP(DL)=^(%(DL)) F %A(DL)=1:1 S X=$P(DIPP(DL),";",%A(DL)) Q:X=""  D DJ
    8: EXIT	K DIFILE,DIPP,%A,% S X="" Q
    9: 	;
   10: DJ	S Y=+$P(X,":",1),Z=+$P(X,":",2) I Y,Z S X=Y-.00000001 F  S X=$O(^DD(DIFILE(DL),X)) S:X="" X=-1 Q:X=Z  G Q:X'>0 S %B=X,X=$P(^(X,0),U,1),Y="" D W S X=%B
   11: 	I $L(X)<30 S Y=$S($D(^DD(DIFILE(DL),X,0)):^(0),1:""),X=$S(Y]"":$P(Y,U,1),1:X)
   12: W	W !?DL*2-2,W," EDIT FIELD: ",X,"//" S W="THEN" Q:'$P(Y,U,2)  S DL=DL+1,DIFILE(DL)=+$P(Y,U,2),%(DL)=0 D A Q
   13: Q	Q
   14: 	;
   15: UP	S DL=DL-1 G EXIT:'DL Q
   16: 	;
   17: AUD	N DP S DIIX="3^.01^A",DP=+DO(2) D AUDIT:DP>0 K DIANUM Q
   18: AUDIT	;
   19: 	I $D(^DD(DP,+$P(DIIX,U,2),"AX")) X ^("AX") Q:'$T
   20: 	K % S DIEX=X D @+DIIX
   21: 	K DPS,DIEX,DIEDA,DIEF,%T,DIIX,%F,%D,%
   22: 	Q
   23: 3	;
   24: 	I $D(DG),DG]"",$D(DIANUM(DG)) S Y=X,(DIEX(1),C)=$P(^DD(DP,+$P(DIIX,U,2),0),U,2) D Y^DIQ S @(DIANUM(DG)_"+DIIX)")=Y K DIANUM(DG) G I
   25: 2	;
   26: 	S:$D(DP(1)) DPS=DP(1) S DIEDA="",DIEF="",%=1,DP(1)=DP,%F=+DP,X=DA
   27: 	F C=1:1 Q:'$D(^DD(DP(1),0,"UP"))  S %F=^("UP"),%=$O(^DD(%F,"SB",DP(1),0)) S:%="" %=-1 S DIEDA=DA(C)_","_DIEDA,DIEF=%_","_DIEF,DP(1)=%F
   28: 	D ADD I $D(DG),DG]"" S DIANUM(DG)="^DIA("_%F_","_+Y_","
   29: 	S (DIEX(1),C)=$P(^DD(DP,+$P(DIIX,U,2),0),U,2),Y=DIEX D Y^DIQ
   30: 	S ^DIA(%F,"B",DIEDA_DA,%D)="",X=DIEX S:$D(DPS) DP(1)=DPS
   31: 	S ^DIA(%F,%D,0)=DIEDA_DA_U_%T_U_DIEF_+$P(DIIX,U,2)_U_DUZ_U_$P(DIIX,U,3),^(+DIIX)=Y
   32: I	I DIEX(1)["P"!(DIEX(1)["V")!(DIEX(1)["S") S ^(DIIX+.1)=X_U_DIEX(1)
   33: 	Q
   34: ADD	I '$D(^DIA(%F,0)) S ^DIA(%F,0)=$P(^DIC(%F,0),U,1)_" AUDIT^1.1I"
   35: 	F Y=$P(^(0),U,3):1 I '$D(^(Y)) L +^DIA(%F,Y):0 Q:$T
   36: 	S $P(^(0),U,3,4)=Y_U_($P(^(0),U,4)+1),^(Y,0)=X L -^DIA(%F,Y)
   37: 	S %D=Y,%T=$P($H,",",2),%T=%T#60/100+(%T#3600\60)/100+(%T\3600)/100,%T=DT_%T
   38: 	S ^DIA(%F,"C",%T,Y)="",^DIA(%F,"D",DUZ,Y)=""
   39: 	Q