GECSULOC ;WISC/RFJ-lock system ;01 Nov 93
;;2.0;GCS;;MAR 14, 1995
Q
;
;
LOCKSYS(GECSSYST) ; lock generic code sheet system
; gecssyst='SITE'-'SYSTEM ID'-'BATCH or TRANSMIT'
; example: 460-VOL-BATCH
; return entry number for success, 0 if already locked
;
; system not found in file, add it
I '$O(^GECS(2101.6,"B",GECSSYST,0)) D
. L +^GECS(2101.6):10 I '$T Q
. N D0,DD,DIC,DLAYGO,X,Y
. S DIC="^GECS(2101.6,",DIC(0)="L",DLAYGO=2101.6,X=GECSSYST D FILE^DICN
. L -^GECS(2101.6)
S DA=+$O(^GECS(2101.6,"B",GECSSYST,0)) I 'DA W !,"Unable to add system ",GECSSYST," to LOCK file # 2101.6." Q 0
;
L +^GECS(2101.6,DA):30
; success
I $T D NOW^%DTC S $P(^GECS(2101.6,DA,0),"^",2,4)="^"_DUZ_"^"_% Q DA
;
; already locked, show who
S %=^GECS(2101.6,DA,0),Y=$P(%,"^",4) I Y D DD^%DT
W !,"SYSTEM ",GECSSYST," IS CURRENTLY LOCKED BY ",$P($G(^VA(200,+$P(%,"^",3),0)),"^")," ON ",Y,"."
Q 0
;
;
UNLOCK(DA) ; unlock generic code sheet system da
I '$D(^GECS(2101.6,DA,0)) Q
S $P(^GECS(2101.6,DA,0),"^",2,4)="^^"
L -^GECS(2101.6,DA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSULOC 1128 printed Sep 23, 2025@19:32:39 Page 2
GECSULOC ;WISC/RFJ-lock system ;01 Nov 93
+1 ;;2.0;GCS;;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
LOCKSYS(GECSSYST) ; lock generic code sheet system
+1 ; gecssyst='SITE'-'SYSTEM ID'-'BATCH or TRANSMIT'
+2 ; example: 460-VOL-BATCH
+3 ; return entry number for success, 0 if already locked
+4 ;
+5 ; system not found in file, add it
+6 IF '$ORDER(^GECS(2101.6,"B",GECSSYST,0))
Begin DoDot:1
+7 LOCK +^GECS(2101.6):10
IF '$TEST
QUIT
+8 NEW D0,DD,DIC,DLAYGO,X,Y
+9 SET DIC="^GECS(2101.6,"
SET DIC(0)="L"
SET DLAYGO=2101.6
SET X=GECSSYST
DO FILE^DICN
+10 LOCK -^GECS(2101.6)
End DoDot:1
+11 SET DA=+$ORDER(^GECS(2101.6,"B",GECSSYST,0))
IF 'DA
WRITE !,"Unable to add system ",GECSSYST," to LOCK file # 2101.6."
QUIT 0
+12 ;
+13 LOCK +^GECS(2101.6,DA):30
+14 ; success
+15 IF $TEST
DO NOW^%DTC
SET $PIECE(^GECS(2101.6,DA,0),"^",2,4)="^"_DUZ_"^"_%
QUIT DA
+16 ;
+17 ; already locked, show who
+18 SET %=^GECS(2101.6,DA,0)
SET Y=$PIECE(%,"^",4)
IF Y
DO DD^%DT
+19 WRITE !,"SYSTEM ",GECSSYST," IS CURRENTLY LOCKED BY ",$PIECE($GET(^VA(200,+$PIECE(%,"^",3),0)),"^")," ON ",Y,"."
+20 QUIT 0
+21 ;
+22 ;
UNLOCK(DA) ; unlock generic code sheet system da
+1 IF '$DATA(^GECS(2101.6,DA,0))
QUIT
+2 SET $PIECE(^GECS(2101.6,DA,0),"^",2,4)="^^"
+3 LOCK -^GECS(2101.6,DA)
+4 QUIT
