55 lines
3.3 KiB
Mathematica
55 lines
3.3 KiB
Mathematica
YTFILE ;SLC/TGA-INSTRUMENT FILE MGMT. ;10/3/02 15:41
|
|
;;5.01;MENTAL HEALTH;**13,77**;Dec 30, 1994
|
|
;
|
|
L +^YTD(601.2,YSDFN):0 I '$D(^YTD(601.2,YSDFN,0)) L +^YTD(601.2,0):0 S ^YTD(601.2,YSDFN,0)=YSDFN,^YTD(601.2,"B",YSDFN,YSDFN)=""
|
|
I S X=^YTD(601.2,0),X(3)=$P(X,U,3),X(4)=$P(X,U,4) S X(4)=X(4)+1 S:YSDFN>X(3) X(3)=YSDFN S ^(0)=$P(X,U,1,2)_"^"_X(3)_"^"_X(4) L -^YTD(601.2,0)
|
|
S YSEN=YSTEST I $D(^YTD(601.2,YSDFN,1,YSEN)) G 11
|
|
I '$D(^YTD(601.2,YSDFN,1,0)) S ^(0)="^601.21PA^^"
|
|
S X=^YTD(601.2,YSDFN,1,0)
|
|
1 ;
|
|
S:YSEN>$P(X,U,3) $P(X,U,3)=YSEN S $P(X,U,4)=$P(X,U,4)+1,^YTD(601.2,YSDFN,1,0)=X,^YTD(601.2,YSDFN,1,YSEN,0)=YSTEST,^YTD(601.2,YSDFN,1,"B",YSEN,YSEN)=""
|
|
11 ;
|
|
I '$D(^YTD(601.2,YSDFN,1,YSEN,1,0)) S ^(0)="^601.22DA^^"
|
|
I '$D(^YTD(601.2,YSDFN,1,YSEN,1,DT,0)) S ^(0)=DT,X=^YTD(601.2,YSDFN,1,YSEN,1,0),$P(X,U,4)=$P(X,U,4)+1 S:DT>$P(X,U,3) $P(X,U,3)=DT S ^(0)=X
|
|
;
|
|
I $G(YSLC)="" D
|
|
. S YSLC=DUZ(2)
|
|
;
|
|
S X=DT_"^"_IO_"^"_YSORD_"^"_DUZ_"^"_$G(YSDTA)_"^"_$S($D(YSCLERK):1,1:2)_"^"_YSLC_"^"
|
|
S ^YTD(601.2,YSDFN,1,YSEN,1,DT,0)=X_$G(YSBEGIN)
|
|
S I=0 F S I=$O(^YTD(601.2,YSDFN,1,YSEN,1,DT,I)) Q:'I K ^(I)
|
|
I $D(YSCLERK) S YSTEST=YSCLERK
|
|
K YSENT I $D(^YTD(601.4,YSDFN,1,YSTEST)) S YSENT=YSTEST,K=0 F S K=$O(^YTD(601.4,YSDFN,1,YSENT,K)) Q:'K S ^YTD(601.2,YSDFN,1,YSEN,1,DT,K)=^YTD(601.4,YSDFN,1,YSENT,K)
|
|
S:YSRP'="" ^YTD(601.2,YSDFN,1,YSEN,1,DT,J+199\200)=YSRP
|
|
S DIK="^YTD(601.2,",DA=YSDFN,DA(1)=YSEN,DA(2)=DT D IX^DIK K DIK ;ASF 10/02/02
|
|
S YSTEST(1)=$S($D(YSCLERK):1,1:2) I YSTEST(1)=1 S YSTEST=YSCL
|
|
I $P(^YTT(601,YSTEST,0),U,9)="T" S X=$E(DT,1,5) S:$D(^YTD(601.2,"AD",YSLC,YSTEST(1),X,YSTEST)) ^(YSTEST)=^(YSTEST)+1 S:'$D(^(YSTEST)) ^(YSTEST)=1
|
|
L D:$D(YSENT) ENKIL Q:'$D(YSCLERK) Q:'$D(^YTT(601,YSTEST,"T")) Q:^("T")']"" D XF Q
|
|
ENKIL ;
|
|
L +^YTD(601.4,YSDFN):0 K ^YTD(601.4,YSDFN,1,YSENT) I '$D(YSCLERK) K ^YTD(601.4,YSDFN,1,"B",YSTEST)
|
|
E K ^YTD(601.4,YSDFN,1,"AC",YSCL),^YTD(601.4,YSDFN,1,"B",YSCLERK)
|
|
I $D(^YTD(601.4,YSDFN,1,0)) S X=$P(^(0),U,4),X=X-1 S:X<0 X=0 S $P(^(0),U,4)=X
|
|
I '$O(^YTD(601.4,YSDFN,1,0)) D
|
|
.K ^YTD(601.4,YSDFN),^YTD(601.4,"B",YSDFN) L +^YTD(601.4,0):0 S X=^YTD(601.4,0),X4=$P(X,U,4),X3=$P(X,U,3),X4=X4-1 S:X4<0 X4=0 S:'$O(^YTD(601.4,0)) X3="" S ^YTD(601.4,0)=$P(X,U,1,2)_"^"_X3_"^"_X4
|
|
.L -^YTD(601.4,0)
|
|
L -^YTD(601.4,YSDFN)
|
|
Q
|
|
;
|
|
EN4 ;
|
|
L:YS4D +^YTD(601.4,YSDFN):0 D EN40:'YS4D,42 L -^YTD(601.4,YSDFN) Q
|
|
EN40 ;
|
|
S YS4D=1 L +^YTD(601.4,YSDFN):0 I '$D(^YTD(601.4,YSDFN,0)) L +^YTD(601.4,0):0 S X=^YTD(601.4,0),X(4)=$P(X,U,4),X(3)=$P(X,U,3),X(4)=X(4)+1 S:YSDFN>X(3) X(3)=YSDFN S X=$P(X,U,1,2)_"^"_X(3)_"^"_X(4) L -^YTD(601.4,0)
|
|
I S ^YTD(601.4,0)=X,^YTD(601.4,YSDFN,0)=YSDFN,^YTD(601.4,"B",YSDFN,YSDFN)=""
|
|
I '$D(^YTD(601.4,YSDFN,1,0)) S ^YTD(601.4,YSDFN,1,0)="^601.41P^^"
|
|
L -^YTD(601.4,YSDFN) S YSENT=$S($D(YSCLERK):YSCLERK,1:YSTEST) I $D(^YTD(601.4,YSDFN,1,YSENT)) Q
|
|
S X=^YTD(601.4,YSDFN,1,0) S:YSENT>$P(X,U,3) $P(X,U,3)=YSENT S $P(X,U,4)=$P(X,U,4)+1,^YTD(601.4,YSDFN,1,0)=X Q
|
|
42 ;
|
|
S ^YTD(601.4,YSDFN,1,YSENT,0)=YSENT_"^"_YSHD_"^^"_(J+1)_"^"_$G(C),^YTD(601.4,YSDFN,1,"B",YSENT,YSENT)=""
|
|
I $D(B) S ^YTD(601.4,YSDFN,1,YSENT,"B")=B
|
|
S ^YTD(601.4,YSDFN,1,YSENT,J\200)=YSRP,YSRP="" Q
|
|
XF ;
|
|
K X S I=0 F S I=$O(^YTD(601.2,YSDFN,1,YSEN,1,DT,I)) Q:'I S X(I)=^(I)
|
|
X:$D(^YTT(601,YSTEST,"T")) ^YTT(601,YSTEST,"T") F I=0:0 S I=$O(X(I)) Q:'I S ^YTD(601.2,YSDFN,1,YSEN,1,DT,I)=X(I)
|
|
;
|
|
K YS4D,YSBEGIN,YSCL,YSCLERK,YSDTA,YSEN,YSHD,YSLC,YSORD
|