| [613] | 1 | PRCE58P2 ;WISC/SAW,LDB-CONTROL POINT ACTIVITY 1358 PRINTOUT ; 07/07/93 2:36 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | G P
|
|---|
| 5 | QUE I $D(ZTQUEUED) S DA=D0
|
|---|
| 6 | S DA=D0,PRCSOB=1
|
|---|
| 7 | P U IO W:$Y>0 @IOF S U="^",PRCSP=1,L="",$P(L,"-",80)="-" D NOW^%DTC S Y=% D DD^%DT
|
|---|
| 8 | D NODE^PRCS58OB(DA,.TRNODE) S PRCSTN=$P($G(TRNODE(0)),U),PRC("SITE")=+PRCSTN W !,PRCSTN,?36,Y,?72,"PAGE ",PRCSP D UL
|
|---|
| 9 | D NEWP1 W !,"Originator of Request: " I $D(TRNODE(14)),TRNODE(14)'="" W $P($G(^VA(200,TRNODE(14),0)),"^"),!
|
|---|
| 10 | W !,"Requestor:",?41,"|Date Requested:",?62,"|Obligation No.:"
|
|---|
| 11 | W ! K P1 I $D(TRNODE(7)) S P1=TRNODE(7) I +P1 S X=$P($G(^VA(200,+P1,0)),U) W X
|
|---|
| 12 | W ?41,"|" I $D(TRNODE(1)) S Y=$P(TRNODE(1),U) I Y D DD^%DT W Y
|
|---|
| 13 | W ?62,"|" I $D(TRNODE(4)),$P(TRNODE(4),U,5)'="" S PRCSPO=$P(TRNODE(4),U,5) W ?65,PRC("SITE")_"-"_PRCSPO
|
|---|
| 14 | D UL W !,"Vendor:",?41,"|Contract Number:"
|
|---|
| 15 | W ! I $D(TRNODE(2)) W $P(TRNODE(2),U)
|
|---|
| 16 | W ?41,"|" K PRCSG I $D(TRNODE(3)) S PRCSG=TRNODE(3) I $P(PRCSG,U,10)]"" W $P(PRCSG,U,10)
|
|---|
| 17 | W ! I $D(TRNODE(2)),TRNODE(2)]"" W $P(TRNODE(2),U,2),?41,"|",!,$P(TRNODE(2),U,6)_", " W $S($D(^DIC(5,+$P(TRNODE(2),U,7),0)):$P(^(0),U,2),1:" ")_" "_$P(TRNODE(2),U,8)
|
|---|
| 18 | W ?41,"|" D UL W !,"Name and Title Approving Official:",?41,"|Signature/Date Signed:"
|
|---|
| 19 | K P W ! I $D(P1) S P=$P(P1,U,3) I P S X=$S($D(^VA(200,P,20)):$P(^(20),U,2),1:"") W $E(X,1,30)
|
|---|
| 20 | K P W ! I $D(P1) S P=$P(P1,U,3) I P S X=$S($G(^VA(200,P,20)):$P(^(20),U,2),1:"") W $E(X,1,30)
|
|---|
| 21 | W ?41,"|" I $D(P),P,$P(P1,U,6)'="" S X=$$DECODE^PRCSC1(DA) W "/ES/"_$E(X,1,28)
|
|---|
| 22 | W ?62,"/" I $D(P1) S Y=$S($P(P1,U,7):$P(P1,U,7),1:$P(P1,U,5)) I Y D DD^%DT W Y K Y
|
|---|
| 23 | W ! I $D(P1) W $P(P1,U,4)
|
|---|
| 24 | W ?41,"|" D UL W !,"FUND CERTIFICATION:",!,"The supplies and services listed on this request are properly chargeable"
|
|---|
| 25 | W !,"to the following allotments, the available balances of which are"
|
|---|
| 26 | W !,"sufficient to cover the cost thereof, and funds have been obligated."
|
|---|
| 27 | D UL W !,"Appropriation and Accounting Symbols:",?41,"|Obligated By: ",?62,"|Date Obligated:"
|
|---|
| 28 | S DIWL=0,DIWR=80,DIWF="" K ^UTILITY($J)
|
|---|
| 29 | I $D(TRNODE(8)) S X1=0 F I=1:1 S X1=$O(TRNODE(8,X1)) Q:X1="" S X=TRNODE(8,X1),PRCSDAA=DA D DIWP^PRCUTL($G(DA)) S DA=PRCSDAA K PRCSDAA
|
|---|
| 30 | S P=PRC("SITE") I $D(PRCSG) S:$P(PRCSG,U,2)]"" P=P_"-"_$P(PRCSG,U,2) S P=P_"-"_$P(PRCSTN,"-",4) S:$P(PRCSG,U,3)]"" P=P_"-"_$P($P(PRCSG,U,3)," ") S:$P(PRCSG,U,6) P=P_"-"_+$P(PRCSG,U,6)
|
|---|
| 31 | I $D(TRNODE(3)),$P($G(TRNODE(3)),"^",12)'="" S PROJ=$P(TRNODE(3),"^",12),P=P_" "_PROJ
|
|---|
| 32 | W !,P,?41,"|" K PRCSG I $D(TRNODE(4)) S PRCSG=TRNODE(4) I $P(PRCSG,U,9),$P(PRCSG,U,10)'="" S X=$$DECODE^PRCSC2(DA) W "/ES/"_$E(X,1,28)
|
|---|
| 33 | W ?62,"|" I $D(PRCSG) S Y=$P(PRCSG,U,4) I Y D DD^%DT W Y
|
|---|
| 34 | D UL W !,"Purpose:" I $D(^UTILITY($J,"W",DIWL)) S Z=^UTILITY($J,"W",DIWL) F I=1:1:Z W !,^UTILITY($J,"W",DIWL,I,0) I IOSL-$Y<3 D UL,NEWP
|
|---|
| 35 | I IOSL-$Y<10 D NEWP
|
|---|
| 36 | D ^PRCE58P3
|
|---|
| 37 | K %DT,CT,UT,P1,P,PRCSP,PRCSA,PRCSG,PRCSOB,PRCSPO,PRCSTN,X,X1,Y,DIWL,DIWR,DIWF,Z,DA,I,L,^UTILITY($J) D:$D(ZTQUEUED) KILL^%ZTLOAD Q
|
|---|
| 38 | UL W ! N I F I=1:1:80 W @IOBS
|
|---|
| 39 | W L Q
|
|---|
| 40 | NEWP ;PRINT HEADER FOR NEW PAGE
|
|---|
| 41 | W !!,"VA FORM 4-1358a-ADP (NOV 1987)" W:$Y>0 @IOF
|
|---|
| 42 | S PRCSP=PRCSP+1 W !,$P(TRNODE(0),U) W:$D(PRCSPO) ?40,PRC("SITE")_"-"_PRCSPO W ?72,"PAGE ",PRCSP D UL
|
|---|
| 43 | NEWP1 I '$D(PRCSOB) W !,?14,"ESTIMATED MISCELLANEOUS OBLIGATION OR CHANGE IN OBLIGATION" D UL
|
|---|
| 44 | E W !,?26,"REQUEST FOR 1358 OBLIGATION/ADJUSTMENT" D UL
|
|---|
| 45 | Q
|
|---|
