XBSITE.m

XBSITE ; IHS/ADC/GTH - SET "DUZ(2)" ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

L1 ;

 KILL DIC

 G:$D(DUZ)=0!($D(DUZ)=10) ERRMSG

 I ('$D(^DIC(3,DUZ,0))),('$D(^VA(200,DUZ,0))) G ERRMSG

 I ('$D(^DIC(3,DUZ,2,0))),('$D(^VA(200,DUZ,2,0))) G ERRMSG1

 I +DUZ(2)>0 S DIC("B")=$P(^DIC(4,DUZ(2),0),"^",1) G B1

 S DIC("B")="Site set to zero (0) for Universal"

B1 ;

 W !!

 D ASK

 S SITENUM=DUZ(2)

 KILL DIC("A"),DIC("B"),DA,DR,Y

 Q

 ;

ASK ;

 S DIC="^DIC(3,DUZ,2,",DIC("A")="Enter your facility's name: ",DIC(0)="QAEM"

 I $D(^VA(200,DUZ,2,0)) S DIC="^VA(200,DUZ,2,"

 D ^DIC

 G:X["?" ASK

 I X="^",$D(DIC("B")) W !,*7,"The default facility remains ",DIC("B"),!! Q

 S DUZ(2)=+Y

 I DUZ(2)<1 S DUZ(2)=$P(^AUTTSITE(1,0),U,1) W !,*7,"The default facility has been set to ",$P(^DIC(4,DUZ(2),0),"^",1),!!

 S SITENUM=DUZ(2)

 Q

 ;

SET ;PEP - Request Set of DUZ(2) from applications.

 G L1

 ;

ERRMSG ;

 W !!,"USER not set in DUZ - use KERNEL!"

 Q

 ;

ERRMSG1 ;

 W !!,"No Divisions (facilities) set in USER file!"

 Q

 ;

ERRMSG2 ;

 W !!,"That facility is not included in your Divisions field in the USER file!"

 Q

 ;

XBSITE    ; IHS/ADC/GTH - SET "DUZ(2)" ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

L1        ;

 +1        KILL DIC

 +2        IF $DATA(DUZ)=0!($DATA(DUZ)=10)

               GOTO ERRMSG

 +3        IF ('$DATA(^DIC(3,DUZ,0)))

               IF ('$DATA(^VA(200,DUZ,0)))

                   GOTO ERRMSG

 +4        IF ('$DATA(^DIC(3,DUZ,2,0)))

               IF ('$DATA(^VA(200,DUZ,2,0)))

                   GOTO ERRMSG1

 +5        IF +DUZ(2)>0

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

               GOTO B1

 +6        SET DIC("B")="Site set to zero (0) for Universal"

B1        ;

 +1        WRITE !!

 +2        DO ASK

 +3        SET SITENUM=DUZ(2)

 +4        KILL DIC("A"),DIC("B"),DA,DR,Y

 +5        QUIT 

 +6       ;

ASK       ;

 +1        SET DIC="^DIC(3,DUZ,2,"

           SET DIC("A")="Enter your facility's name: "

           SET DIC(0)="QAEM"

 +2        IF $DATA(^VA(200,DUZ,2,0))

               SET DIC="^VA(200,DUZ,2,"

 +3        DO ^DIC

 +4        IF X["?"

               GOTO ASK

 +5        IF X="^"

               IF $DATA(DIC("B"))

                   WRITE !,*7,"The default facility remains ",DIC("B"),!!

                   QUIT 

 +6        SET DUZ(2)=+Y

 +7        IF DUZ(2)<1

               SET DUZ(2)=$PIECE(^AUTTSITE(1,0),U,1)

               WRITE !,*7,"The default facility has been set to ",$PIECE(^DIC(4,DUZ(2),0),"^",1),!!

 +8        SET SITENUM=DUZ(2)

 +9        QUIT 

 +10      ;

SET       ;PEP - Request Set of DUZ(2) from applications.

 +1        GOTO L1

 +2       ;

ERRMSG    ;

 +1        WRITE !!,"USER not set in DUZ - use KERNEL!"

 +2        QUIT 

 +3       ;

ERRMSG1   ;

 +1        WRITE !!,"No Divisions (facilities) set in USER file!"

 +2        QUIT 

 +3       ;

ERRMSG2   ;

 +1        WRITE !!,"That facility is not included in your Divisions field in the USER file!"

 +2        QUIT 

 +3       ;