| 1 | PRCSEM ;WISC/KMB-DELIVERY RECEIVING,OBLIGATION DATA ;6-6-95 12:00
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | S PRCSEM=1 D EDTD^PRCSEB0 K PRCSEM
|
|---|
| 5 | ;
|
|---|
| 6 | Q
|
|---|
| 7 | ENOD ;ENTER OBLIGATION DATA
|
|---|
| 8 | D EN3^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0
|
|---|
| 9 | S DIC="^PRCS(410,",DIE=DIC,DIC(0)="AEQM",DIC("S")="I +^(0),$D(^(3)),+^(3)=+PRC(""CP""),$P(^(0),""^"",5)=PRC(""SITE""),$P(^(0),""^"",2)=""O"" I $D(^PRC(420,""A"",DUZ,PRC(""SITE""),+PRC(""CP""),1))!($D(^(2)))"
|
|---|
| 10 | D ^PRCSDIC G EXIT:Y<0 K DIC("S") S (DA,PRCS)=+Y L +^PRCS(410,DA):5 G ENOD:$T=0
|
|---|
| 11 | ENOD1 ;
|
|---|
| 12 | N VALUE,OBLAMT1 S VALUE=$P(^PRCS(410,DA,0),"^") I $D(^PRCS(410,DA,4)),$P(^(4),"^",3)>0 S OBLAMT1=$P(^(4),"^",3)
|
|---|
| 13 | W !,"Committed (Estimated) Cost:" I $D(^PRCS(410,DA,4)),$P(^(4),U)]"" W ?28,$J($P(^(4),U),0,2)
|
|---|
| 14 | E W ?28,"None entered."
|
|---|
| 15 | S DR="[PRCSENOD]",DIE=DIC D ^DIE
|
|---|
| 16 | I $D(^PRCS(410,DA,4)),$P(^(4),"^",3)>0 D:$P(^(4),"^",10)]"" REMOVE^PRCSC2(DA) D ENCODE^PRCSC2(DA,DUZ),ERS410^PRC0G(DA_"^O")
|
|---|
| 17 | S:'$D(PRCS) PRCS=DA L -^PRCS(410,DA)
|
|---|
| 18 | N OBLAMT2 I $D(^PRCS(410,DA,4)),$P(^(4),"^",3)>0 S OBLAMT2=$P(^(4),"^",3)
|
|---|
| 19 | I $D(OBLAMT1),$D(OBLAMT2),OBLAMT2<OBLAMT1 D SENDIT
|
|---|
| 20 | D W3 G EXIT:%'=1 W !! G ENOD
|
|---|
| 21 | SENDIT ;
|
|---|
| 22 | N XX,XMY,XMDUZ,XMSUB,XMTEXT S XX=$P($G(^PRCS(410,DA,7)),"^",1) S:XX="" XX=$P($G(^PRCS(410,DA,7)),"^",3) Q:XX=""
|
|---|
| 23 | S XMDUZ=DUZ,XMY(XX)=""
|
|---|
| 24 | S XMSUB="OBLIGATION DECREASE NOTIFICATION"
|
|---|
| 25 | N ARRAY S ARRAY(1)="The obligation amount for transaction "_VALUE,ARRAY(2)="has been decreased from $"_OBLAMT1_" to $"_OBLAMT2_"."
|
|---|
| 26 | S XMTEXT="ARRAY(" D ^XMD Q
|
|---|
| 27 | W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
|
|---|
| 28 | W3 W !!,"Would you like to enter another obligation" S %=1 D YN^DICN G W3:%=0 Q
|
|---|
| 29 | EXIT K DA,DIC,DIE,DR,PRCS,PRCS58,PRCSL,T,X,X1,Y,DLAYGO Q
|
|---|
