source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFALCK.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1PRCFALCK ;WISC@ALTOONA/CTB-CHECK FISCAL LOCK FILE ; 03/21/94 10:30 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4LOCK N X0,X1,X2,X3,Y
5 S %=0 G FAIL:'$D(X)#2,FAIL:X="",FAIL:'$D(^PRCF(421.4,"B",X)) S X1=$O(^PRCF(421.4,"B",X,0)) I X1="" G FAIL
6 L +^PRCF(421.4,X1,0):1 I $T S X0=^PRCF(421.4,X1,0) I +$P(X0,"^",2)=0 D NOW^%DTC S ^PRCF(421.4,X1,0)=$P(X0,"^",1)_"^1^"_DUZ_"^"_% S %=1 L -^PRCF(421.4,X1,0) Q
7 S X0=^PRCF(421.4,X1,0)
8 S X3=$P(X0,"^",3) I +X3>0,$D(^VA(200,X3,0)) S X3=$P(^(0),"^",1)
9 E S %=0,X3="an unknown person"
10 I $D(ZTIO),ZTIO=""!(ZTIO="@") G OUT
11 W !!!,X," lock was set by ",X3 S Y=$P(X0,"^",4) D DD^%DT W:Y]"" " on ",Y,"."
12 W !,"No further action taken. Contact your supervisor to clear the lock."
13OUT I $G(X1) L -^PRCF(421.4,X1,0) Q
14FAIL W !!!,"Corruption exists in the FISCAL LOCK file.",!,"PLEASE CONTACT YOUR SITE MANAGER.",!!!!! S %=0 Q
15 ;
16CLEAR ;Clear a lock
17 S DIC=421.4,DIC(0)="AEMZQ" D ^DIC K DIC Q:Y<0
18 I +$P(Y(0),"^",2)=0 S $P(^PRCF(421.4,+Y,0),"^",3)="" W !!,$P(Y(0),"^")," Lock is not in use. No action taken." K Y Q
19 S DA=+Y F I=1:1:4 S X(I)=$P(Y(0),"^",I)
20 S Y=X(4) D D^PRCFQ S X(3)=$S($D(^VA(200,X(3),0)):$P(^(0),"^"),1:"an unknown person")
21 W ! S %A="It looks like the lock was set by "_X(3)_$S(Y]"":" on "_Y,1:"")
22 S %A(1)="Have you checked with all your users to be sure that "_X(1),%A(2)="is not in progress on the system",%B="",%=2 D ^PRCFYN I %'=1 D NA Q
23 S %A="Are you sure that you want to clear this lock",%B="",%=2 D ^PRCFYN I %'=1 D NA Q
24 W !!,"OK, I will now clear the ",X(1)," lock." S ^PRCF(421.4,DA,0)=$P(^PRCF(421.4,DA,0),"^",1) K X,Y S X=" ---Done---" D MSG^PRCFQ Q
25NA S X=" No action taken" D MSG^PRCFQ K Y,X Q
26UNLOCK ;INTERNAL ENTRY TO CLEAR LOCK. REQUIRES VARIABLE X EQUAL TO LOCK NAME
27 S X1=$O(^PRCF(421.4,"B",X,0)) Q:X1="" S ^(0)=$P(^PRCF(421.4,+X1,0),"^",1) K X,X1 Q
Note: See TracBrowser for help on using the repository browser.