PRCB1A2 ;WISC/PLT-FCP ACTIVATE/DEACTIVATE ; 01/11/94 10:40 AM
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
QUIT ;invalid entry
;
REA ;reactivate an inactive fund control point
N PRCDD,PRCDR,PRCDI,PRCRI,PRCPR,PRCAED,PRCQT,PRCU,A,B,X,Y S PRCU="^"
N PRCFA S PRCFA("REACTIVATE")=""
S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT1
S PRCDD=420,PRCRI(420)=PRC("SITE")
I '$O(^PRC(420,PRCRI(420),1,"B","")) D EN^DDIOL("No Control Point in file!") G EXIT1
S PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_",",Y=3 D ICLOCK^PRC0B(PRCLOCK,.Y)
I 'Y D EN^DDIOL("File is in use, please try later!") G EXIT1
F D EN^DDIOL(" ") D Q:PRCQT=1
. N PRCDD,PRCAED,PRCDI
. S PRCDD=420.01,PRCQT=""
. S X(0)="AENOQS",X("S")="I X-9999,$P(^(0),U,19)=1"
. D LKUP^PRCB1A Q:PRCQT
. D EDIT1
. QUIT
D DCLOCK^PRC0B(PRCLOCK)
EXIT1 QUIT
;
EDIT1 ;edit inactive/active
D EDIT^PRC0B(.X,PRCDI,"20Active/Inactive Control Point","") I X=0 S PRCQT=2
K A D PIECE^PRC0B(PRCDI,20,"I","A")
S X=$G(A(PRCDD,PRCRI(PRCDD),"1~20","I")) K A
S X=$S(X=1:"23////^S X=DUZ;24///NOW",1:"23///^S X=""@"";24///^S X=""@""")
D EDIT^PRC0B(.X,PRCDI,X)
QUIT
;
DEA ;deactivate an active fund control point
N PRCDD,PRCDR,PRCDI,PRCRI,PRCPR,PRCAED,PRCQT,PRCU,A,B,X,Y S PRCU="^"
K PRCFA S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT2
S PRCDD=420,PRCRI(420)=PRC("SITE")
I '$O(^PRC(420,PRCRI(420),1,"B","")) D EN^DDIOL("No Control Point in file!") G EXIT2
S PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_",",Y=3 D ICLOCK^PRC0B(PRCLOCK,.Y)
I 'Y D EN^DDIOL("File is in use, please try later!") G EXIT2
F D EN^DDIOL(" ") D Q:PRCQT=1
. N PRCDD,PRCAED,PRCDI
. S PRCDD=420.01,PRCQT=""
. S X(0)="AENOQS",X("S")="I X-9999,$P(^(0),U,19)'=1"
. D LKUP^PRCB1A Q:PRCQT
. D EDIT2
. QUIT
D DCLOCK^PRC0B(PRCLOCK)
EXIT2 QUIT
;
EDIT2 ;edit active/inactive
D EDIT^PRC0B(.X,PRCDI,"20Active/Inactive Control Point","") I X=1 S PRCQT=2
K A D PIECE^PRC0B(PRCDI,"1~20","I","A")
S X=$G(A(PRCDD,PRCRI(PRCDD),20,"I")) K A
S X=$S(X=1:"23////^S X=DUZ;24///NOW",1:"23///^S X=""@"";24///^S X=""@""")
D EDIT^PRC0B(.X,PRCDI,X)
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCB1A2 2162 printed Oct 16, 2024@18:00:58 Page 2
PRCB1A2 ;WISC/PLT-FCP ACTIVATE/DEACTIVATE ; 01/11/94 10:40 AM
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;invalid entry
QUIT
+4 ;
REA ;reactivate an inactive fund control point
+1 NEW PRCDD,PRCDR,PRCDI,PRCRI,PRCPR,PRCAED,PRCQT,PRCU,A,B,X,Y
SET PRCU="^"
+2 NEW PRCFA
SET PRCFA("REACTIVATE")=""
+3 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
GOTO EXIT1
+4 SET PRCDD=420
SET PRCRI(420)=PRC("SITE")
+5 IF '$ORDER(^PRC(420,PRCRI(420),1,"B",""))
DO EN^DDIOL("No Control Point in file!")
GOTO EXIT1
+6 SET PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_","
SET Y=3
DO ICLOCK^PRC0B(PRCLOCK,.Y)
+7 IF 'Y
DO EN^DDIOL("File is in use, please try later!")
GOTO EXIT1
+8 FOR
DO EN^DDIOL(" ")
Begin DoDot:1
+9 NEW PRCDD,PRCAED,PRCDI
+10 SET PRCDD=420.01
SET PRCQT=""
+11 SET X(0)="AENOQS"
SET X("S")="I X-9999,$P(^(0),U,19)=1"
+12 DO LKUP^PRCB1A
if PRCQT
QUIT
+13 DO EDIT1
+14 QUIT
End DoDot:1
if PRCQT=1
QUIT
+15 DO DCLOCK^PRC0B(PRCLOCK)
EXIT1 QUIT
+1 ;
EDIT1 ;edit inactive/active
+1 DO EDIT^PRC0B(.X,PRCDI,"20Active/Inactive Control Point","")
IF X=0
SET PRCQT=2
+2 KILL A
DO PIECE^PRC0B(PRCDI,20,"I","A")
+3 SET X=$GET(A(PRCDD,PRCRI(PRCDD),"1~20","I"))
KILL A
+4 SET X=$SELECT(X=1:"23////^S X=DUZ;24///NOW",1:"23///^S X=""@"";24///^S X=""@""")
+5 DO EDIT^PRC0B(.X,PRCDI,X)
+6 QUIT
+7 ;
DEA ;deactivate an active fund control point
+1 NEW PRCDD,PRCDR,PRCDI,PRCRI,PRCPR,PRCAED,PRCQT,PRCU,A,B,X,Y
SET PRCU="^"
+2 KILL PRCFA
SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
GOTO EXIT2
+3 SET PRCDD=420
SET PRCRI(420)=PRC("SITE")
+4 IF '$ORDER(^PRC(420,PRCRI(420),1,"B",""))
DO EN^DDIOL("No Control Point in file!")
GOTO EXIT2
+5 SET PRCLOCK=$$DICGL^PRC0B1(PRCDD)_PRCRI(PRCDD)_","
SET Y=3
DO ICLOCK^PRC0B(PRCLOCK,.Y)
+6 IF 'Y
DO EN^DDIOL("File is in use, please try later!")
GOTO EXIT2
+7 FOR
DO EN^DDIOL(" ")
Begin DoDot:1
+8 NEW PRCDD,PRCAED,PRCDI
+9 SET PRCDD=420.01
SET PRCQT=""
+10 SET X(0)="AENOQS"
SET X("S")="I X-9999,$P(^(0),U,19)'=1"
+11 DO LKUP^PRCB1A
if PRCQT
QUIT
+12 DO EDIT2
+13 QUIT
End DoDot:1
if PRCQT=1
QUIT
+14 DO DCLOCK^PRC0B(PRCLOCK)
EXIT2 QUIT
+1 ;
EDIT2 ;edit active/inactive
+1 DO EDIT^PRC0B(.X,PRCDI,"20Active/Inactive Control Point","")
IF X=1
SET PRCQT=2
+2 KILL A
DO PIECE^PRC0B(PRCDI,"1~20","I","A")
+3 SET X=$GET(A(PRCDD,PRCRI(PRCDD),20,"I"))
KILL A
+4 SET X=$SELECT(X=1:"23////^S X=DUZ;24///NOW",1:"23///^S X=""@"";24///^S X=""@""")
+5 DO EDIT^PRC0B(.X,PRCDI,X)
+6 QUIT
+7 ;
