Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GECSULOC

GECSULOC.m

Go to the documentation of this file.
  1. GECSULOC ;WISC/RFJ-lock system ;01 Nov 93
  1. ;;2.0;GCS;;MAR 14, 1995
  1. Q
  1. ;
  1. ;
  1. LOCKSYS(GECSSYST) ; lock generic code sheet system
  1. ; gecssyst='SITE'-'SYSTEM ID'-'BATCH or TRANSMIT'
  1. ; example: 460-VOL-BATCH
  1. ; return entry number for success, 0 if already locked
  1. ;
  1. ; system not found in file, add it
  1. I '$O(^GECS(2101.6,"B",GECSSYST,0)) D
  1. . L +^GECS(2101.6):10 I '$T Q
  1. . N D0,DD,DIC,DLAYGO,X,Y
  1. . S DIC="^GECS(2101.6,",DIC(0)="L",DLAYGO=2101.6,X=GECSSYST D FILE^DICN
  1. . L -^GECS(2101.6)
  1. S DA=+$O(^GECS(2101.6,"B",GECSSYST,0)) I 'DA W !,"Unable to add system ",GECSSYST," to LOCK file # 2101.6." Q 0
  1. ;
  1. L +^GECS(2101.6,DA):30
  1. ; success
  1. I $T D NOW^%DTC S $P(^GECS(2101.6,DA,0),"^",2,4)="^"_DUZ_"^"_% Q DA
  1. ;
  1. ; already locked, show who
  1. S %=^GECS(2101.6,DA,0),Y=$P(%,"^",4) I Y D DD^%DT
  1. W !,"SYSTEM ",GECSSYST," IS CURRENTLY LOCKED BY ",$P($G(^VA(200,+$P(%,"^",3),0)),"^")," ON ",Y,"."
  1. Q 0
  1. ;
  1. ;
  1. UNLOCK(DA) ; unlock generic code sheet system da
  1. I '$D(^GECS(2101.6,DA,0)) Q
  1. S $P(^GECS(2101.6,DA,0),"^",2,4)="^^"
  1. L -^GECS(2101.6,DA)
  1. Q