- 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 Feb 18, 2025@23:26:35 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 ;