YTCROSS.m

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 ---YTCROSS   721     printed  Apr 09, 2024@21:19:58                                                                                                                                                                                                      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)