PRCBCPE ;WISC@ALTOONA/CTB-CONTROL POINT EDIT ; 01/03/94 9:53 AM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
OUT K C,D,D0,DA,DI,DIC,DIE,DINUM,DLAYGO,DQ,DR,DWLW,I,J,NEW,NEWNAME,OLD,OLDNAME,OLDNUM,PRCFA,X,Y Q
ADD ;ADD NEW FUND CONTROL POINT
K PRCFA S PRCF("X")="AS" D ^PRCFSITE Q:'%
I '$D(^PRC(420,PRC("SITE"))) K DD,DO S (DINUM,X)=PRC("SITE"),DIC="^PRC(420,",DIC(0)="EMNQL",DLAYGO=420 D FILE^DICN G OUT:Y<0 S $P(^PRC(420,+Y,1,0),"^",2)="420.01s"
K PRCFA("OUT") D CPEDIT I '$D(PRCFA("OUT")) S DIE="^PRC(420,",DA=PRC("SITE"),DR="2;3" D ^DIE
K PRCFA("OUT") G OUT
CPEDIT K PRCFA S DIC("S")="I X'=9999",PRCFA("ALL")="",DA(1)=PRC("SITE"),DLAYGO=420.01,DIC="^PRC(420,"_DA(1)_",1,",DIC(0)="AEMNZLQ" D ^DIC I X["^" S PRCFA("OUT")="" Q
Q:+Y<0 S DA=+Y,OLD=$P(Y(0),"^"),OLDNUM=$P(OLD," "),OLDNAME=$P(OLD," ",2,99)
I $P(Y(0),"^",19)'=1 G C
E S %A="This Control Point has been marked as INACTIVE, do you wish to",%A(1)="reactivate it at this time",%B="",%=2 D ^PRCFYN
I %<0 S PRCFA("OUT")="" Q
I %=2 S %A="Are you sure you what to reactivate this Control Point",%B="" D ^PRCFYN I %<0 S PRCFA("OUT")="" Q
I %=2 S X=" <No Action Taken>*" D MSG^PRCFQ
I %=1 S $P(^PRC(420,DA(1),1,DA,0),"^",23,24)="^",$P(^(0),"^",19)=0,X=" --Fund Control Point has been reactivated*" D MSG^PRCFQ
C W ! S %A="Do you need to edit the Fund Control Point Name",%B="",%=2 D ^PRCFYN G AD1:%=2 I %<0 S PRCFA("OUT")="" Q
W ! S %A="You may edit only the NAME of this Control Point, you may NOT change the number",%A(1)="Do you REALLY wish to change the NAME of this Fund Control Point",%B="",%=1 D ^PRCFYN G AD1:%=2 I %<0 S PRCFA("OUT")="" Q
AD2 S Y=OLDNAME W !!,"Fund Control Point NAME: ",Y W:$X>48 !?9 W "// "
I $L(OLDNAME)>19 D RW^PRCBSA Q:$D(X)[0
I $L(OLDNAME)<20 R X:DTIME I '$T!(X["^") S PRCFA("OUT")="" Q
G:X="" AD1
I X["?"!($L(X)>30)!(+X=+OLDNUM)!(X'?1.30ANP) W !,$C(7),"Enter FUND CONTROL POINT NAME, (up to ",30-$L(OLDNUM)," characters), do not include the NUMBER" G AD2
S NEW=OLDNUM_" "_X,NEWNAME=X,%A=" ",%A(1)="The NEW Fund Control Point Number and Name will be:",%A(2)=NEW,%A(3)="IS THIS CORRECT",%B="",%=2 D ^PRCFYN G AD2:%=2 I %<0 S PRCFA("OUT")="" Q
S %A="OK to update the file",%=1,%B="" D ^PRCFYN I %<0 S PRCFA("OUT")="" Q
I %=2 S X=" <No Updating has Occurred>*" D MSG^PRCFQ G AD1
K ^PRC(420,DA(1),1,"B",$E(OLD,1,30),DA),^PRC(420,DA(1),1,"C",$E(OLDNAME,1,30),DA)
S $P(^PRC(420,DA(1),1,DA,0),"^")=NEW,^PRC(420,DA(1),1,"B",$E(NEW,1,30),DA)="",^PRC(420,DA(1),1,"C",$E(NEWNAME,1,30),DA)="",X=" <Fund Control Point name has been changed.>*" D MSG^PRCFQ
AD1 S DIE=DIC,DR=".5;1;4;12;6;13;7;8;14;22" D ^DIE W:$P(^PRC(420,DA(1),1,DA,0),"^",11)["N" "Notify users of this control point that the control point is non-automated!"
W ! S DIC("A")="Select next FUND CONTROL POINT: "
G CPEDIT
Q I X="^" K X
Q
REA ;REACTIVATE AN INACTIVE FUND CONTROL POINT
K PRCFA S PRCF("X")="AS" D ^PRCFSITE Q:'%
S $P(^PRC(420,PRC("SITE"),1,0),"^",2)="420.01s"
REA1 S PRCFA("REACTIVATE")="",DA(1)=PRC("SITE"),DIC="^PRC(420,"_DA(1)_",1,",DIC(0)="AEMQN" D ^DIC K DIC G:Y<0 OUT S DA=+Y
W !,$C(7) S %A="Are you sure that you wish to reactivate this Fund Control Point",%B="",%=1 D ^PRCFYN G OUT:%<0 I %=2 D NA G REA1
S $P(^PRC(420,DA(1),1,DA,0),"^",23,24)="^",$P(^(0),"^",19)=0,X=" --Fund Control Point has been reactivated*" D MSG^PRCFQ S DIC("A")="Select Next Fund Control Point: " G REA1
DEA ;DEACTIVATE A CONTROL POINT
K PRCFA S PRCF("X")="AS" D ^PRCFSITE Q:'%
S $P(^PRC(420,PRC("SITE"),1,0),"^",2)="420.01s"
DEA1 S DA(1)=PRC("SITE"),DIC="^PRC(420,"_DA(1)_",1,",DIC(0)="AEMQN" D ^DIC K DIC G:Y<0 OUT S DA=+Y
W !,$C(7) S %A="Are you sure that you wish to deactivate this Fund Control Point",%B="",%=1 D ^PRCFYN G OUT:%<0 I %=2 D NA G DEA1
S $P(^PRC(420,DA(1),1,DA,0),"^",23,24)=DUZ_"^"_DT,$P(^(0),"^",19)=1,X=" --Fund Control Point has been deactivated*" D MSG^PRCFQ W ! S DIC("A")="Select Next FUND CONTROL POINT: " G DEA
Q
NA S X="<No Action Taken>*" D MSG^PRCFQ Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCBCPE 4053 printed Nov 22, 2024@17:10:42 Page 2
PRCBCPE ;WISC@ALTOONA/CTB-CONTROL POINT EDIT ; 01/03/94 9:53 AM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
OUT KILL C,D,D0,DA,DI,DIC,DIE,DINUM,DLAYGO,DQ,DR,DWLW,I,J,NEW,NEWNAME,OLD,OLDNAME,OLDNUM,PRCFA,X,Y
QUIT
ADD ;ADD NEW FUND CONTROL POINT
+1 KILL PRCFA
SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
+2 IF '$DATA(^PRC(420,PRC("SITE")))
KILL DD,DO
SET (DINUM,X)=PRC("SITE")
SET DIC="^PRC(420,"
SET DIC(0)="EMNQL"
SET DLAYGO=420
DO FILE^DICN
if Y<0
GOTO OUT
SET $PIECE(^PRC(420,+Y,1,0),"^",2)="420.01s"
+3 KILL PRCFA("OUT")
DO CPEDIT
IF '$DATA(PRCFA("OUT"))
SET DIE="^PRC(420,"
SET DA=PRC("SITE")
SET DR="2;3"
DO ^DIE
+4 KILL PRCFA("OUT")
GOTO OUT
CPEDIT KILL PRCFA
SET DIC("S")="I X'=9999"
SET PRCFA("ALL")=""
SET DA(1)=PRC("SITE")
SET DLAYGO=420.01
SET DIC="^PRC(420,"_DA(1)_",1,"
SET DIC(0)="AEMNZLQ"
DO ^DIC
IF X["^"
SET PRCFA("OUT")=""
QUIT
+1 if +Y<0
QUIT
SET DA=+Y
SET OLD=$PIECE(Y(0),"^")
SET OLDNUM=$PIECE(OLD," ")
SET OLDNAME=$PIECE(OLD," ",2,99)
+2 IF $PIECE(Y(0),"^",19)'=1
GOTO C
+3 IF '$TEST
SET %A="This Control Point has been marked as INACTIVE, do you wish to"
SET %A(1)="reactivate it at this time"
SET %B=""
SET %=2
DO ^PRCFYN
+4 IF %<0
SET PRCFA("OUT")=""
QUIT
+5 IF %=2
SET %A="Are you sure you what to reactivate this Control Point"
SET %B=""
DO ^PRCFYN
IF %<0
SET PRCFA("OUT")=""
QUIT
+6 IF %=2
SET X=" <No Action Taken>*"
DO MSG^PRCFQ
+7 IF %=1
SET $PIECE(^PRC(420,DA(1),1,DA,0),"^",23,24)="^"
SET $PIECE(^(0),"^",19)=0
SET X=" --Fund Control Point has been reactivated*"
DO MSG^PRCFQ
C WRITE !
SET %A="Do you need to edit the Fund Control Point Name"
SET %B=""
SET %=2
DO ^PRCFYN
if %=2
GOTO AD1
IF %<0
SET PRCFA("OUT")=""
QUIT
+1 WRITE !
SET %A="You may edit only the NAME of this Control Point, you may NOT change the number"
SET %A(1)="Do you REALLY wish to change the NAME of this Fund Control Point"
SET %B=""
SET %=1
DO ^PRCFYN
if %=2
GOTO AD1
IF %<0
SET PRCFA("OUT")=""
QUIT
AD2 SET Y=OLDNAME
WRITE !!,"Fund Control Point NAME: ",Y
if $X>48
WRITE !?9
WRITE "// "
+1 IF $LENGTH(OLDNAME)>19
DO RW^PRCBSA
if $DATA(X)[0
QUIT
+2 IF $LENGTH(OLDNAME)<20
READ X:DTIME
IF '$TEST!(X["^")
SET PRCFA("OUT")=""
QUIT
+3 if X=""
GOTO AD1
+4 IF X["?"!($LENGTH(X)>30)!(+X=+OLDNUM)!(X'?1.30ANP)
WRITE !,$CHAR(7),"Enter FUND CONTROL POINT NAME, (up to ",30-$LENGTH(OLDNUM)," characters), do not include the NUMBER"
GOTO AD2
+5 SET NEW=OLDNUM_" "_X
SET NEWNAME=X
SET %A=" "
SET %A(1)="The NEW Fund Control Point Number and Name will be:"
SET %A(2)=NEW
SET %A(3)="IS THIS CORRECT"
SET %B=""
SET %=2
DO ^PRCFYN
if %=2
GOTO AD2
IF %<0
SET PRCFA("OUT")=""
QUIT
+6 SET %A="OK to update the file"
SET %=1
SET %B=""
DO ^PRCFYN
IF %<0
SET PRCFA("OUT")=""
QUIT
+7 IF %=2
SET X=" <No Updating has Occurred>*"
DO MSG^PRCFQ
GOTO AD1
+8 KILL ^PRC(420,DA(1),1,"B",$EXTRACT(OLD,1,30),DA),^PRC(420,DA(1),1,"C",$EXTRACT(OLDNAME,1,30),DA)
+9 SET $PIECE(^PRC(420,DA(1),1,DA,0),"^")=NEW
SET ^PRC(420,DA(1),1,"B",$EXTRACT(NEW,1,30),DA)=""
SET ^PRC(420,DA(1),1,"C",$EXTRACT(NEWNAME,1,30),DA)=""
SET X=" <Fund Control Point name has been changed.>*"
DO MSG^PRCFQ
AD1 SET DIE=DIC
SET DR=".5;1;4;12;6;13;7;8;14;22"
DO ^DIE
if $PIECE(^PRC(420,DA(1),1,DA,0),"^",11)["N"
WRITE "Notify users of this control point that the control point is non-automated!"
+1 WRITE !
SET DIC("A")="Select next FUND CONTROL POINT: "
+2 GOTO CPEDIT
Q IF X="^"
KILL X
+1 QUIT
REA ;REACTIVATE AN INACTIVE FUND CONTROL POINT
+1 KILL PRCFA
SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
+2 SET $PIECE(^PRC(420,PRC("SITE"),1,0),"^",2)="420.01s"
REA1 SET PRCFA("REACTIVATE")=""
SET DA(1)=PRC("SITE")
SET DIC="^PRC(420,"_DA(1)_",1,"
SET DIC(0)="AEMQN"
DO ^DIC
KILL DIC
if Y<0
GOTO OUT
SET DA=+Y
+1 WRITE !,$CHAR(7)
SET %A="Are you sure that you wish to reactivate this Fund Control Point"
SET %B=""
SET %=1
DO ^PRCFYN
if %<0
GOTO OUT
IF %=2
DO NA
GOTO REA1
+2 SET $PIECE(^PRC(420,DA(1),1,DA,0),"^",23,24)="^"
SET $PIECE(^(0),"^",19)=0
SET X=" --Fund Control Point has been reactivated*"
DO MSG^PRCFQ
SET DIC("A")="Select Next Fund Control Point: "
GOTO REA1
DEA ;DEACTIVATE A CONTROL POINT
+1 KILL PRCFA
SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
QUIT
+2 SET $PIECE(^PRC(420,PRC("SITE"),1,0),"^",2)="420.01s"
DEA1 SET DA(1)=PRC("SITE")
SET DIC="^PRC(420,"_DA(1)_",1,"
SET DIC(0)="AEMQN"
DO ^DIC
KILL DIC
if Y<0
GOTO OUT
SET DA=+Y
+1 WRITE !,$CHAR(7)
SET %A="Are you sure that you wish to deactivate this Fund Control Point"
SET %B=""
SET %=1
DO ^PRCFYN
if %<0
GOTO OUT
IF %=2
DO NA
GOTO DEA1
+2 SET $PIECE(^PRC(420,DA(1),1,DA,0),"^",23,24)=DUZ_"^"_DT
SET $PIECE(^(0),"^",19)=1
SET X=" --Fund Control Point has been deactivated*"
DO MSG^PRCFQ
WRITE !
SET DIC("A")="Select Next FUND CONTROL POINT: "
GOTO DEA
+3 QUIT
NA SET X="<No Action Taken>*"
DO MSG^PRCFQ
QUIT
+1 ;
