source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSP11.m@ 1078

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

initial load of WorldVistAEHR

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