ADEM.m

ADEM ; IHS/HQT/MJL  - HEADER ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 D ^ADECLS

 I $D(^DIC(9.4,"B","IHS DENTAL")) D

 . S ADE=$O(^DIC(9.4,"B","IHS DENTAL",0))

 . I $D(^DIC(9.4,ADE,"VERSION")) S ADE("V")=$P(^DIC(9.4,ADE,"VERSION"),"^")

 . E  S ADE("V")="5.4T6"

 S:'$D(ADE("V")) ADE("V")="5.4T6"

 W ?21,"    *****************************",!

 W ?21,"  *****                       *****",!

 W ?21," *****  INDIAN HEALTH SERVICE  *****",!

 W ?21,"  *****   DENTAL DATA SYSTEM  *****",!

 W ?21,"   *****   VERSION ",$J(ADE("V"),7),"  *****",!

 W ?21,"     *****                 *****",!

 W ?21,"       ***********************",!

 W ?21,"         ********* *********",!

 W ?21,"           ******   ******",!

 W ?21,"             ***     ***",!

SITE I $D(DUZ(2)),DUZ(2)>0 S ADE("SITE")=$P(^DIC(4,DUZ(2),0),"^",1) W !,?80-$L(ADE("SITE"))\2,ADE("SITE") G END

NOSITE W !!,"DIVISION NOT SET IN 'USER' FILE. CONTACT SITE MANAGER TO SET",!,"DIVISION BEFORE GOING FURTHER." S XQUIT=1

 ;

END K ADE

 Q

ADEM      ; IHS/HQT/MJL  - HEADER ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2        DO ^ADECLS

 +3        IF $DATA(^DIC(9.4,"B","IHS DENTAL"))

               Begin DoDot:1

 +4                SET ADE=$ORDER(^DIC(9.4,"B","IHS DENTAL",0))

 +5                IF $DATA(^DIC(9.4,ADE,"VERSION"))

                       SET ADE("V")=$PIECE(^DIC(9.4,ADE,"VERSION"),"^")

 +6               IF '$TEST

                       SET ADE("V")="5.4T6"

               End DoDot:1

 +7        IF '$DATA(ADE("V"))

               SET ADE("V")="5.4T6"

 +8        WRITE ?21,"    *****************************",!

 +9        WRITE ?21,"  *****                       *****",!

 +10       WRITE ?21," *****  INDIAN HEALTH SERVICE  *****",!

 +11       WRITE ?21,"  *****   DENTAL DATA SYSTEM  *****",!

 +12       WRITE ?21,"   *****   VERSION ",$JUSTIFY(ADE("V"),7),"  *****",!

 +13       WRITE ?21,"     *****                 *****",!

 +14       WRITE ?21,"       ***********************",!

 +15       WRITE ?21,"         ********* *********",!

 +16       WRITE ?21,"           ******   ******",!

 +17       WRITE ?21,"             ***     ***",!

SITE       IF $DATA(DUZ(2))

               IF DUZ(2)>0

                   SET ADE("SITE")=$PIECE(^DIC(4,DUZ(2),0),"^",1)

                   WRITE !,?80-$LENGTH(ADE("SITE"))\2,ADE("SITE")

                   GOTO END

NOSITE     WRITE !!,"DIVISION NOT SET IN 'USER' FILE. CONTACT SITE MANAGER TO SET",!,"DIVISION BEFORE GOING FURTHER."

           SET XQUIT=1

 +1       ;

END        KILL ADE

 +1        QUIT