Return to DIET.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIET.m, revision 1.1.1.1

1.1       snw         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