- 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 Feb 18, 2025@23:22:57 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