| 1 | PRCSEB1 ;WISC/SAW,DGL-CONTROL POINT ACTIVITY EDITS CON'T; [7/21/98 3:35pm]
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ENOD ;ENTER OBLIGATION DATA
|
|---|
| 5 | W !,"This option is no longer in use." Q
|
|---|
| 6 | ENOD1 ;
|
|---|
| 7 | W !,"Committed (Estimated) Cost: " I $D(^PRCS(410,DA,4)),$P(^(4),U)]"" W ?28,$J($P(^(4),U),0,2)
|
|---|
| 8 | E W ?28,"None entered."
|
|---|
| 9 | S DR="[PRCSENOD]",DIE=DIC D ^DIE S:'$D(PRCS) PRCS=DA Q:$D(PRCSOB) G EXIT
|
|---|
| 10 | ENCAD ;ENTER FMS DATA
|
|---|
| 11 | D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
|
|---|
| 12 | S DIC="^PRCS(410,",DIC(0)="AEQ",DIC("A")="Select PURCHASE ORDER/OBLIGATION NO: ",D="D"
|
|---|
| 13 | S DIC("S")="I +^(0),$D(^(3)),+^(3)=+$P(PRC(""CP""),"" ""),$P(^(0),""^"",5)=PRC(""SITE"") I $D(^PRC(420,""A"",DUZ,PRC(""SITE""),+PRC(""CP""),1))!($D(^(2)))" D ^PRCSDIC G EXIT:Y<0 K DIC("S"),DIC("A")
|
|---|
| 14 | S DA=+Y L +^PRCS(410,DA):15 G ENCAD:$T=0 S DIC(0)="AEMQ",DIE=DIC,DR="[PRCSENCAD]" D ^DIE L -^PRCS(410,DA) S T(1)="FMS (820)" D W3 G EXIT:%'=1 W !! G ENCAD
|
|---|
| 15 | ENA ;ENTER AN ADJUSTMENT
|
|---|
| 16 | N AMOUNT,PO,REC,PODATE,SITE
|
|---|
| 17 | D EN^PRCSUT G W2:'$D(PRC("SITE")) G EXIT:'$D(PRC("QTR"))!(Y<0)
|
|---|
| 18 | D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENA:$T=0 S $P(^PRCS(410,DA,0),U,2)="A"
|
|---|
| 19 | D ADDADJ
|
|---|
| 20 | S T(1)="Adjustment" K PRCS58 D W3 G EXIT:%'=1 W !! G ENA
|
|---|
| 21 | ;
|
|---|
| 22 | ;D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENA:$T=0 S $P(^PRCS(410,DA,0),U,2)="A"
|
|---|
| 23 | ;
|
|---|
| 24 | ADDADJ S DIE="^PRCS(410,",DR="450////O;449////"_$P($$QTRDATE^PRC0D(PRC("FY"),PRC("QTR")),"^",7) D ^DIE K DR
|
|---|
| 25 | ENA1 S DIC(0)="AEMQ",DIE=DIC,DR="24OBLIGATION NUMBER~R" D ^DIE K DR G CT:$D(Y)
|
|---|
| 26 | S SITE=PRC("SITE"),$P(^PRCS(410,DA,7),"^")=DUZ
|
|---|
| 27 | N PRCX442 S PRCX442=X,PRCX442=$$UPPER^PRCFFU5(PRCX442) D OBL^PRCSES2 S X=PRCX442
|
|---|
| 28 | S DIC(0)="AEMQ",DIE="^PRCS(410,"
|
|---|
| 29 | ENA2 K DR S DR="[PRCSENA]" I $D(PRCS58) S DR="[PRCSENA 1358]"
|
|---|
| 30 | D ^DIE G CT:$D(Y) I '$D(^PRCS(410,DA,4)) W $C(7),!,"You must enter an Adjustment $ Amount for this transaction.",! G ENA2
|
|---|
| 31 | I $D(^PRC(420,PRC("SITE"),1,+PRC("CP"),0)),$P(^(0),U,12)>0 G ENA3
|
|---|
| 32 | I $D(^PRCS(410,DA,4)) S X=$P(^(4),"^",6),X2=^(3),X1=$P(X2,"^",7)+$P(X2,"^",9) I $J(X,0,2)'=$J(X1,0,2) W $C(7),!,"Adjustment $ Amount does not equal the total of BOC $ Amounts.",!,"Please correct the error.",! G ENA2
|
|---|
| 33 | S AMOUNT=$P($G(^PRCS(410,DA,4)),"^",6),$P(^PRCS(410,DA,4),"^",8)=AMOUNT
|
|---|
| 34 | ENA3 ;D:$O(^PRCS(410,DA,12,0)) SCPC0^PRCSED
|
|---|
| 35 | S PO=$P($G(^PRCS(410,DA,4)),"^",5) I PO'="",$D(^PRC(442,"C",PO)) S REC=$O(^PRC(442,"C",PO,0)),PODATE=$P($G(^PRC(442,+REC,1)),"^",15) S DR="23///^S X=PODATE",DIE="^PRCS(410," D ^DIE
|
|---|
| 36 | L -^PRCS(410,DA)
|
|---|
| 37 | QUIT
|
|---|
| 38 | ENFIS ;from fiscal's option
|
|---|
| 39 | N PRC,AMOUNT,PO,REC,PODATE,SITE
|
|---|
| 40 | N A,B,C,X,Y,Z
|
|---|
| 41 | D SITE^PRCB0C G EXIT:'$G(PRC("SITE"))
|
|---|
| 42 | D SUBSITE^PRCB0C G EXIT:'$G(PRC("SST"))&$D(^PRC(411,"UP",+PRC("SITE")))
|
|---|
| 43 | D FY^PRCB0C G EXIT:PRC("FY")="^" D QTR^PRCB0C G EXIT:'$G(PRC("QTR"))
|
|---|
| 44 | D FCP^PRCB0C G EXIT:'$G(PRC("CP")) D BBFY^PRCB0C G:'$G(PRC("BBFY")) EXIT
|
|---|
| 45 | S Z=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," "),X=$P(Z,"-",1,2)_"-"_$P(PRC("CP")," ")
|
|---|
| 46 | D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENFIS:$T=0 S $P(^PRCS(410,DA,0),U,2)="A"
|
|---|
| 47 | S DIE="^PRCS(410,",DR="25.5//NO" D ^DIE K DR G CT:$D(Y)
|
|---|
| 48 | D ADDADJ
|
|---|
| 49 | S T(1)="Adjustment" K PRCS58 D W3 G EXIT:%'=1 W !! G ENFIS
|
|---|
| 50 | CT ;CANCEL AN ADJUSTMENT TRANSACTION
|
|---|
| 51 | S T=$P(^PRCS(410,DA,0),"^"),$P(^(11),"^",3)="",$P(^(0),"^",2)="CA",$P(^(5),"^")=0,$P(^(6),"^")=0 K ^PRCS(410,"F",+T_"-"_+PRC("CP")_"-"_$P(T,"-",5),DA),^PRCS(410,"F1",$P(T,"-",5)_"-"_+T_"-"_+PRC("CP"),DA),^PRCS(410,"AQ",1,DA)
|
|---|
| 52 | K ZX I $D(^PRCS(410,DA,4)) S ZX=^(4),X=-$P(ZX,"^",8) D EBAL^PRCSEZ(PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_X,"C") I $P(ZX,"^",14)'="Y" D EBAL^PRCSEZ(PRC("SITE")_"^"_PRC("CP")_"^"_PRC("FY")_"^"_PRC("QTR")_"^"_X,"O")
|
|---|
| 53 | F I=1,3,6,8 S $P(ZX,"^",I)=0
|
|---|
| 54 | I $D(ZX) S ^PRCS(410,DA,4)=ZX K ZX
|
|---|
| 55 | I $D(^PRCS(410,DA,12,0)) S N=0 F S N=$O(^PRCS(410,DA,12,N)) Q:N'>0 S X=$P(^(N,0),"^",2) I X S DA(1)=DA,DA=N D TRANK^PRCSEZZ S DA=DA(1)
|
|---|
| 56 | W !!,"This adjustment has been cancelled." G EXIT
|
|---|
| 57 | ENC ;ENTER CEILING TRANSACTION
|
|---|
| 58 | D EN^PRCSUT G W2:'$D(PRC("SITE")) G EXIT:'$D(PRC("QTR"))!(Y<0) D EN1^PRCSUT3 Q:'X S X1=X D EN2^PRCSUT3 Q:'$D(X1) S X=X1 D W L +^PRCS(410,DA):15 G ENC:$T=0 S DIC(0)="AEMQ",DIE=DIC,DR="[PRCSENC]" D ^DIE
|
|---|
| 59 | L -^PRCS(410,DA) S T(1)="Ceiling" D W3 G EXIT:%'=1 W !! G ENC
|
|---|
| 60 | CPU ;ENTER/EDIT CONTROL POINT USERS
|
|---|
| 61 | N PRCSSC S PRCSSC=0
|
|---|
| 62 | D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0 S DA(1)=PRC("SITE"),DA=+PRC("CP")
|
|---|
| 63 | I $D(PRCSC) S PRCSSC=PRCSC I '$D(^PRC(420,"A",DUZ,PRC("SITE"),+PRC("CP"),PRCSSC)) W !,"You cannot use this option for this control point." G EXIT
|
|---|
| 64 | CPU1 D EDIT^PRC0B(.X,"420;^PRC(420,;"_DA(1)_"~420.01;^PRC(420,"_DA(1)_",1,;"_DA,"12;6","L")
|
|---|
| 65 | I X=-2 D EN^DDIOL("Fund control point is in use, try later.")
|
|---|
| 66 | D TUSER(+$P(PRC("CP")," "))
|
|---|
| 67 | Q
|
|---|
| 68 | TUSER(CP) ;Check for IFCAP terminated users
|
|---|
| 69 | N A,XDA,ST,I,J
|
|---|
| 70 | W !!,"Checking for IFCAP terminated users...",!
|
|---|
| 71 | S XDA=0,ST=PRC("SITE"),I=0,J=0 F S XDA=$O(^PRC(420,ST,1,CP,1,XDA)) Q:XDA="" D
|
|---|
| 72 | . S A=$G(^VA(200,XDA,0))
|
|---|
| 73 | . I A="" D TUSER1 Q ;Dangling pointer removed
|
|---|
| 74 | . I $D(^PRC(411,ST,8,XDA,0))#10=1 S I=I+1 D TUSER1 W !?5,$P(A,"^",1)," is deactivated and was removed as a Control Point User *"
|
|---|
| 75 | . D NOW^%DTC
|
|---|
| 76 | . I $P(A,"^",11)>0,$P(A,"^",11)<X S J=J+1 D TUSER1 W !?5,$P(A,"^",1)," is terminated and was removed as a Control Point User **"
|
|---|
| 77 | W !!
|
|---|
| 78 | I I>0 W "* CONTACT THE IFCAP APPLICATION COORDINATOR TO REACTIVATE THE USER" W:I>1 "S" W " *",!
|
|---|
| 79 | I J>0 W "** CONTACT IRM TO REACTIVATE IN FILE 200 **",!
|
|---|
| 80 | I J+I=0 W ?5,"None found",!
|
|---|
| 81 | Q
|
|---|
| 82 | TUSER1 S DA=XDA,DA(1)=CP,DA(2)=ST,DIK="^PRC(420,"_DA(2)_",1,"_DA(1)_",1," D ^DIK K DIK
|
|---|
| 83 | Q
|
|---|
| 84 | SENDIT2 ;
|
|---|
| 85 | N XX,XMDUZ,XMSUB,XMTEXT S XMDUZ="IFCAP PROCESSING",XX=$P($G(^PRCS(410,PRCHSY,7)),"^",1) S:XX="" XX=$P($G(^PRCS(410,PRCHSY,7)),"^",3)
|
|---|
| 86 | S XMTEXT="PRCSAR(",XMSUB="SPLIT TRANSACTION NOTIFICATION",XMY(XX)=""
|
|---|
| 87 | D ^XMD Q
|
|---|
| 88 | W W !!,"This transaction is assigned transaction number: ",X Q
|
|---|
| 89 | W1 W !!,"Sorry, you are not allowed to overcommit funds for control point ",$P(PRC("CP")," "),".",!,"Your current balance of $",PRCST1," is insufficient to cover the cost ($",PRCST,")",!,"of this request. Contact Fiscal Service.",$C(7) Q
|
|---|
| 90 | W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
|
|---|
| 91 | W3 W !!,"Would you like to enter another ",T(1)," transaction" S %=1 D YN^DICN G W3:%=0 Q
|
|---|
| 92 | EXIT K DA,DIC,DIE,DR,PRCS,PRCS58,PRCSL,T,X,X1,DLAYGO Q
|
|---|
