BSDVAR ; IHS/ANMC/LJF - MENU ENTRY AND EXIT ACTIONS ; [ 01/02/2004 10:20 AM ]
;;5.3;PIMS;**1011,1012,1013**;APR 26, 2002
;
;This rtn contains the entry & exit actions for the main Scheduling
;menu as well as common subrtns for other menus and options.
;
Q
ENTER ;ENTRY POINT entry actions for SDMENU
D ^XBCLS W !?18 F BSD("I")=1:1:41 W "*"
W !?18,"* INDIAN HEALTH SERVICE *"
W !?18,"* CLINIC SCHEDULING SYSTEM *"
W !?18,"* VERSION ",$$VERSION^XPDUTL("SD"),?58,"*"
W !?18 F BSD("I")=1:1:41 W "*"
;
I '$D(DUZ(2))!('$D(DUZ(0))) D G XQUIT
.W !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE THE"
.W " IHS SCHEDULING SYSTEM" S XQUIT=1
;7/18/02 WAR - omit one line feed
;S X=$P($G(^DIC(4,DUZ(2),0)),U) W !!?80-$L(X)\2,X ;7/18/02 LJF19
S X=$P($G(^DIC(4,DUZ(2),0)),U) W !?80-$L(X)\2,X
I X="" W !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!" S XQUIT=""
;
XQUIT K BSD,X,Y
Q
;
;
S BSD("TITLE")=$P($G(XQY0),U,2)
I $L(BSD("TITLE"))>2 W @IOF,!!?80-$L(BSD("TITLE"))/2,BSD("TITLE")
S X=$P($G(^DIC(4,DUZ(2),0)),U)
W !!?80-$L(X)\2,"(",X,")"
K BSD
Q
;
SITECK ;EP; -- site check for facility
;I '$D(^DG(40.8,"C",DUZ(2))) D G XQUIT ;cmi/maw 10/1/2009 patch 1011 orig
I '$D(^DG(40.8,"AD",DUZ(2))) D G XQUIT ;cmi/maw 10/1/2009 patch 1011 for station number
. W !!,*7,"You are logged into a site that is NOT set up in the"
. W !,"Scheduling package. Please log into the correct site OR"
. W !,"have this site - ",$$GET1^DIQ(4,DUZ(2),.01)," - set up"
. W !,"for Scheduling."
. D PAUSE^BDGF
. S XQUIT=1
Q
;
EXIT ;ENTRY POINT >>> exit actions for BSDMENU
;kill of system-wide variables
Q
BSDVAR ; IHS/ANMC/LJF - MENU ENTRY AND EXIT ACTIONS ; [ 01/02/2004 10:20 AM ]
+1 ;;5.3;PIMS;**1011,1012,1013**;APR 26, 2002
+2 ;
+3 ;This rtn contains the entry & exit actions for the main Scheduling
+4 ;menu as well as common subrtns for other menus and options.
+5 ;
+6 QUIT
ENTER ;ENTRY POINT entry actions for SDMENU
+1 DO ^XBCLS
WRITE !?18
FOR BSD("I")=1:1:41
WRITE "*"
+2 WRITE !?18,"* INDIAN HEALTH SERVICE *"
+3 WRITE !?18,"* CLINIC SCHEDULING SYSTEM *"
+4 WRITE !?18,"* VERSION ",$$VERSION^XPDUTL("SD"),?58,"*"
+5 WRITE !?18
FOR BSD("I")=1:1:41
WRITE "*"
+6 ;
+7 IF '$DATA(DUZ(2))!('$DATA(DUZ(0)))
Begin DoDot:1
+8 WRITE !!,"YOU MUST SIGN ON PROPERLY THROUGH THE KERNEL TO USE THE"
+9 WRITE " IHS SCHEDULING SYSTEM"
SET XQUIT=1
End DoDot:1
GOTO XQUIT
+10 ;7/18/02 WAR - omit one line feed
+11 ;S X=$P($G(^DIC(4,DUZ(2),0)),U) W !!?80-$L(X)\2,X ;7/18/02 LJF19
+12 SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)
WRITE !?80-$LENGTH(X)\2,X
+13 IF X=""
WRITE !!,"INVALID FACILITY; NOTIFY YOUR SITE MANAGER!"
SET XQUIT=""
+14 ;
XQUIT KILL BSD,X,Y
+1 QUIT
+2 ;
+3 ;
+1 SET BSD("TITLE")=$PIECE($GET(XQY0),U,2)
+2 IF $LENGTH(BSD("TITLE"))>2
WRITE @IOF,!!?80-$LENGTH(BSD("TITLE"))/2,BSD("TITLE")
+3 SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)
+4 WRITE !!?80-$LENGTH(X)\2,"(",X,")"
+5 KILL BSD
+6 QUIT
+7 ;
SITECK ;EP; -- site check for facility
+1 ;I '$D(^DG(40.8,"C",DUZ(2))) D G XQUIT ;cmi/maw 10/1/2009 patch 1011 orig
+2 ;cmi/maw 10/1/2009 patch 1011 for station number
IF '$DATA(^DG(40.8,"AD",DUZ(2)))
Begin DoDot:1
+3 WRITE !!,*7,"You are logged into a site that is NOT set up in the"
+4 WRITE !,"Scheduling package. Please log into the correct site OR"
+5 WRITE !,"have this site - ",$$GET1^DIQ(4,DUZ(2),.01)," - set up"
+6 WRITE !,"for Scheduling."
+7 DO PAUSE^BDGF
+8 SET XQUIT=1
End DoDot:1
GOTO XQUIT
+9 QUIT
+10 ;
EXIT ;ENTRY POINT >>> exit actions for BSDMENU
+1 ;kill of system-wide variables
+2 QUIT