YSXRAC8.m

YSXRAC8 ; COMPILED XREF FOR FILE #601.2213 ; 12/28/04

 ; 

 S DA(3)=DA(2) S DA(2)=0 S DA(1)=0 S DA=0

A1 ;

 I $D(DISET) K DIKLM S:DIKM1=3 DIKLM=1 S:DIKM1'=3&'$G(DIKPUSH(3)) DIKPUSH(3)=1,DA(3)=DA(2),DA(2)=DA(1),DA(1)=DA,DA=0 S:DIKM1<2 DA(1)=0 G @DIKM1

A S DA(2)=$O(^YTD(601.2,DA(3),1,DA(2))) I DA(2)'>0 S DA(2)=0 G END

1 ;

B S DA(1)=$O(^YTD(601.2,DA(3),1,DA(2),1,DA(1))) I DA(1)'>0 S DA(1)=0 Q:DIKM1=1  G A

2 ;

C S DA=$O(^YTD(601.2,DA(3),1,DA(2),1,DA(1),"R",DA)) I DA'>0 S DA=0 Q:DIKM1=2  G B

3 ;

 S DIKZ(0)=$G(^YTD(601.2,DA(3),1,DA(2),1,DA(1),"R",DA,0))

 S X=$P(DIKZ(0),U,2)

 I X'="" S ^YTD(601.2,DA(3),1,DA(2),1,DA(1),"R","AD",$E(X,1,30),DA)=""

 G:'$D(DIKLM) C Q:$D(DISET)

END Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---YSXRAC8   694     printed  Apr 09, 2024@21:18:55                                                                                                                                                                                                      Page 2

YSXRAC8   ; COMPILED XREF FOR FILE #601.2213 ; 12/28/04

 +1       ; 

 +2        SET DA(3)=DA(2)

           SET DA(2)=0

           SET DA(1)=0

           SET DA=0

A1        ;

 +1        IF $DATA(DISET)

               KILL DIKLM

               if DIKM1=3

                   SET DIKLM=1

               if DIKM1'=3&'$GET(DIKPUSH(3))

                   SET DIKPUSH(3)=1

                   SET DA(3)=DA(2)

                   SET DA(2)=DA(1)

                   SET DA(1)=DA

                   SET DA=0

               if DIKM1<2

                   SET DA(1)=0

               GOTO @DIKM1

A          SET DA(2)=$ORDER(^YTD(601.2,DA(3),1,DA(2)))

           IF DA(2)'>0

               SET DA(2)=0

               GOTO END

1         ;

B          SET DA(1)=$ORDER(^YTD(601.2,DA(3),1,DA(2),1,DA(1)))

           IF DA(1)'>0

               SET DA(1)=0

               if DIKM1=1

                   QUIT 

               GOTO A

2         ;

C          SET DA=$ORDER(^YTD(601.2,DA(3),1,DA(2),1,DA(1),"R",DA))

           IF DA'>0

               SET DA=0

               if DIKM1=2

                   QUIT 

               GOTO B

3         ;

 +1        SET DIKZ(0)=$GET(^YTD(601.2,DA(3),1,DA(2),1,DA(1),"R",DA,0))

 +2        SET X=$PIECE(DIKZ(0),U,2)

 +3        IF X'=""

               SET ^YTD(601.2,DA(3),1,DA(2),1,DA(1),"R","AD",$EXTRACT(X,1,30),DA)=""

 +4        if '$DATA(DIKLM)

               GOTO C

           if $DATA(DISET)

               QUIT 

END        QUIT