- YTCROSS ;SLC/TGA-SET 'AD' CROSS REFERENCE, FILE 601.2 ; 5/1/89 11:04 ;
- ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- SET ;
- Q:'$D(^YTD(601.2,DA(2),1,DA(1),1,DA,0))
- S YSE=$P(^YTD(601.2,DA(2),1,DA(1),1,DA,0),U,6),YSS=$P(^(0),U,7),YSN=$P(^YTD(601.2,DA(2),1,DA(1),0),U) Q:YSN<1 Q:'$D(^YTT(601,YSN)) Q:$P(^YTT(601,YSN,0),U,9)="I" Q:YSE<1!(YSS<1)
- S X=$E(X,1,5) S:$D(^YTD(601.2,"AD",YSS,YSE,X,YSN)) ^(YSN)=^(YSN)+1 S:'$D(^(YSN)) ^(YSN)=1
- Q
- KILL ;
- Q:$D(YSNOKILL) Q:'$D(^YTD(601.2,DA(2),1,DA(1),1,DA,0))
- S YSE=$P(^YTD(601.2,DA(2),1,DA(1),1,DA,0),U,6),YSS=$P(^(0),U,7),YSN=$P(^YTD(601.2,DA(2),1,DA(1),0),U) Q:YSN<1!(YSS<1)!(YSE<1) S X=$E(X,1,5) I $D(^YTD(601.2,"AD",YSS,YSE,X,YSN)) S ^(YSN)=^(YSN)-1 I ^(YSN)<1 K ^(YSN)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTCROSS 721 printed Mar 13, 2025@21:22 Page 2
- YTCROSS ;SLC/TGA-SET 'AD' CROSS REFERENCE, FILE 601.2 ; 5/1/89 11:04 ;
- +1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- SET ;
- +1 if '$DATA(^YTD(601.2,DA(2),1,DA(1),1,DA,0))
- QUIT
- +2 SET YSE=$PIECE(^YTD(601.2,DA(2),1,DA(1),1,DA,0),U,6)
- SET YSS=$PIECE(^(0),U,7)
- SET YSN=$PIECE(^YTD(601.2,DA(2),1,DA(1),0),U)
- if YSN<1
- QUIT
- if '$DATA(^YTT(601,YSN))
- QUIT
- if $PIECE(^YTT(601,YSN,0),U,9)="I"
- QUIT
- if YSE<1!(YSS<1)
- QUIT
- +3 SET X=$EXTRACT(X,1,5)
- if $DATA(^YTD(601.2,"AD",YSS,YSE,X,YSN))
- SET ^(YSN)=^(YSN)+1
- if '$DATA(^(YSN))
- SET ^(YSN)=1
- +4 QUIT
- KILL ;
- +1 if $DATA(YSNOKILL)
- QUIT
- if '$DATA(^YTD(601.2,DA(2),1,DA(1),1,DA,0))
- QUIT
- +2 SET YSE=$PIECE(^YTD(601.2,DA(2),1,DA(1),1,DA,0),U,6)
- SET YSS=$PIECE(^(0),U,7)
- SET YSN=$PIECE(^YTD(601.2,DA(2),1,DA(1),0),U)
- if YSN<1!(YSS<1)!(YSE<1)
- QUIT
- SET X=$EXTRACT(X,1,5)
- IF $DATA(^YTD(601.2,"AD",YSS,YSE,X,YSN))
- SET ^(YSN)=^(YSN)-1
- IF ^(YSN)<1
- KILL ^(YSN)
