Home Package List Routine Alphabetical List Global Alphabetical List FileMan Files List FileMan Sub-Files List Package Component Lists Package-Namespace Mapping
Routine: XU8P125

XU8P125.m

Go to the documentation of this file.

XU8P125 ;SF-CIOFO/JDS  Post Init for XU*8*125 ;10/01/99  10:28

 ;;KID's Post Init

EN ;

 N DA,DIK

 K ^XTV(8992,"AXQA")

 K ^XTV(8992,"AXQAN")

 S DA(1)=0

 F  S DA(1)=$O(^XTV(8992,DA(1))) Q:DA(1)'>0  D

 . S DIK="^XTV(8992,"_DA(1)_",""XQA"","

 . S DIK(1)=".02^AXQA^AXQAN"

 . D ENALL^DIK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P125   301     printed  Mar 13, 2025@21:11:53                                                                                                                                                                                                      Page 2

XU8P125   ;SF-CIOFO/JDS  Post Init for XU*8*125 ;10/01/99  10:28

 +1       ;;KID's Post Init

 +2       ;

EN        ;

 +1        NEW DA,DIK

 +2        KILL ^XTV(8992,"AXQA")

 +3        KILL ^XTV(8992,"AXQAN")

 +4        SET DA(1)=0

 +5        FOR

               SET DA(1)=$ORDER(^XTV(8992,DA(1)))

               if DA(1)'>0

                   QUIT

               Begin DoDot:1

 +6                SET DIK="^XTV(8992,"_DA(1)_",""XQA"","

 +7                SET DIK(1)=".02^AXQA^AXQAN"

 +8                DO ENALL^DIK

               End DoDot:1

 +9        QUIT