source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSEM.m@ 1796

Last change on this file since 1796 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1PRCSEM ;WISC/KMB-DELIVERY RECEIVING,OBLIGATION DATA ;6-6-95 12:00
2V ;;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
7ENOD ;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
11ENOD1 ;
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
21SENDIT ;
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
27W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
28W3 W !!,"Would you like to enter another obligation" S %=1 D YN^DICN G W3:%=0 Q
29EXIT K DA,DIC,DIE,DR,PRCS,PRCS58,PRCSL,T,X,X1,Y,DLAYGO Q
Note: See TracBrowser for help on using the repository browser.