source: WorldVistAEHR/trunk/r/LIBRARY-LBR-LBRS/LBRYSITE.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1LBRYSITE ;ISC2/DJM-LIBRARY SITE PARAMETERS EDIT ;[ 05/23/97 12:13 PM ]
2 ;;2.5;Library;**2,9**;Mar 11, 1996
3 I '$D(IOP) S IOP=$I D ^%ZIS K IOP Q:POP>0
4 I '$D(DT) D NOW^%DTC S DT=X
5 S LBCK=$G(^DIC(49,0,"GL")) G:LBCK="" FILE I $P(@(LBCK_"0)"),"^",4)'>0 G FILE
6 S LBCK=$G(^DIC(440,0,"GL")) G:LBCK="" FILE I $P(@(LBCK_"0)"),"^",4)'>0 G FILE
7EN1 S DTOUTZ=0 D START G:Y<0 EXIT S DIE=DIC,DR="[LBRY SITE2]",DIE("NO^")="OUTOK" K HFLAG
8 D LOCK^LBRYEDR G:LBRYL=0 EXIT D ^DIE L
9 G:'$D(DA) EN1 G:$D(Y) EN1 D CHECK G:DTOUTZ=1 EXIT G EN1
10START W @IOF,?5,"VA Library Site Parameters Edit" S Y=DT X ^DD("DD") S YDT=Y
11 W ?60,Y,!
12 S DIC="^LBRY(680.6,",DIC(0)="AELQZ" D ^DIC Q:Y<0 S DA=+Y
13 S ZZY(0)=Y(0) W @IOF,?5,"VA Library Site Parameters Edit",?60,YDT,!!
14 Q
15CHECK S CHECK=$G(^LBRY(680.6,DA,0))
16 I $P(CHECK,U,5)="Y",$P(CHECK,U,3)="" S $P(^LBRY(680.6,DA,0),U,5)="N",HFLAG=1 W !!,"AUTOMATIC QUEUING not allowed without entering ROUTING SLIP PRINTER."
17 I $P(CHECK,U,6)="Y",$P(CHECK,U,7)="" S $P(^LBRY(680.6,DA,0),U,6)="N",HFLAG=1 W !!,"Since no Division Site Name was entered MULTI-DIVISION SITE is reset to NO."
18 I '$D(HFLAG)#2 Q
19 W ! S XZ="CONTINUE// " D PAUSE^LBRYCK0 K XZ Q
20EXIT K DTOUTZ,LBRYL,Y,DIC,DLAYGO,DTOUT,DIE,DR,YDT,ZZY,CHECK,HFLAG Q
21FILE S XQH="LBRY FILE MISSING" D EN^XQH K XQH,LBCK Q
Note: See TracBrowser for help on using the repository browser.