FBCTAU3.m

FBCTAU3 ; ;10/31/14

 ;;

1 N X,X1,X2 S DIXR=1151 D X1(U) K X2 M X2=X D X1("F") K X1 M X1=X

 D

 . D AUD^FBAAAUD(0)

 K X M X=X2 D

 . D AUD^FBAAAUD(1)

 Q

X1(DION) K X

 S X(1)=$G(@DIEZTMP@("V",161.01,DIIENS,.01,DION),$P($G(^FBAAA(DA(1),1,DA,0)),U,1))

 S X(2)=$G(@DIEZTMP@("V",161.01,DIIENS,.02,DION),$P($G(^FBAAA(DA(1),1,DA,0)),U,2))

 S X(3)=$G(@DIEZTMP@("V",161.01,DIIENS,.06,DION),$P($G(^FBAAA(DA(1),1,DA,0)),U,15))

 S X(4)=$G(@DIEZTMP@("V",161.01,DIIENS,.07,DION),$P($G(^FBAAA(DA(1),1,DA,0)),U,7))

 S X(5)=$G(@DIEZTMP@("V",161.01,DIIENS,.095,DION),$P($G(^FBAAA(DA(1),1,DA,0)),U,13))

 S X=$G(X(1))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBCTAU3   614     printed  Apr 09, 2024@21:05:11                                                                                                                                                                                                      Page 2

FBCTAU3   ; ;10/31/14

 +1       ;;

1          NEW X,X1,X2

           SET DIXR=1151

           DO X1(U)

           KILL X2

           MERGE X2=X

           DO X1("F")

           KILL X1

           MERGE X1=X

 +1        Begin DoDot:1

 +2            DO AUD^FBAAAUD(0)

           End DoDot:1

 +3        KILL X

           MERGE X=X2

           Begin DoDot:1

 +4            DO AUD^FBAAAUD(1)

           End DoDot:1

 +5        QUIT 

X1(DION)   KILL X

 +1        SET X(1)=$GET(@DIEZTMP@("V",161.01,DIIENS,.01,DION),$PIECE($GET(^FBAAA(DA(1),1,DA,0)),U,1))

 +2        SET X(2)=$GET(@DIEZTMP@("V",161.01,DIIENS,.02,DION),$PIECE($GET(^FBAAA(DA(1),1,DA,0)),U,2))

 +3        SET X(3)=$GET(@DIEZTMP@("V",161.01,DIIENS,.06,DION),$PIECE($GET(^FBAAA(DA(1),1,DA,0)),U,15))

 +4        SET X(4)=$GET(@DIEZTMP@("V",161.01,DIIENS,.07,DION),$PIECE($GET(^FBAAA(DA(1),1,DA,0)),U,7))

 +5        SET X(5)=$GET(@DIEZTMP@("V",161.01,DIIENS,.095,DION),$PIECE($GET(^FBAAA(DA(1),1,DA,0)),U,13))

 +6        SET X=$GET(X(1))

 +7        QUIT