source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSULOC.m@ 1639

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

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1GECSULOC ;WISC/RFJ-lock system ;01 Nov 93
2 ;;2.0;GCS;;MAR 14, 1995
3 Q
4 ;
5 ;
6LOCKSYS(GECSSYST) ; lock generic code sheet system
7 ; gecssyst='SITE'-'SYSTEM ID'-'BATCH or TRANSMIT'
8 ; example: 460-VOL-BATCH
9 ; return entry number for success, 0 if already locked
10 ;
11 ; system not found in file, add it
12 I '$O(^GECS(2101.6,"B",GECSSYST,0)) D
13 . L +^GECS(2101.6):10 I '$T Q
14 . N D0,DD,DIC,DLAYGO,X,Y
15 . S DIC="^GECS(2101.6,",DIC(0)="L",DLAYGO=2101.6,X=GECSSYST D FILE^DICN
16 . L -^GECS(2101.6)
17 S DA=+$O(^GECS(2101.6,"B",GECSSYST,0)) I 'DA W !,"Unable to add system ",GECSSYST," to LOCK file # 2101.6." Q 0
18 ;
19 L +^GECS(2101.6,DA):30
20 ; success
21 I $T D NOW^%DTC S $P(^GECS(2101.6,DA,0),"^",2,4)="^"_DUZ_"^"_% Q DA
22 ;
23 ; already locked, show who
24 S %=^GECS(2101.6,DA,0),Y=$P(%,"^",4) I Y D DD^%DT
25 W !,"SYSTEM ",GECSSYST," IS CURRENTLY LOCKED BY ",$P($G(^VA(200,+$P(%,"^",3),0)),"^")," ON ",Y,"."
26 Q 0
27 ;
28 ;
29UNLOCK(DA) ; unlock generic code sheet system da
30 I '$D(^GECS(2101.6,DA,0)) Q
31 S $P(^GECS(2101.6,DA,0),"^",2,4)="^^"
32 L -^GECS(2101.6,DA)
33 Q
Note: See TracBrowser for help on using the repository browser.