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