source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCB2A.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1PRCB2A ;WISC/(SKR@LBVAMC),PLT,DGL-ROUTINE TO PRINT RECEIVING REPORT PENDING ACTION [7/20/98 2:18pm]
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ;invalid entry point
5 ;
6EN ;pending fiscal action rpt
7INIT S U="^",LINE="" K %ZIS,%IS,IOP,IOC,ZTIO S %IS="MQ" D ^%ZIS Q:POP
8 S (ZSTAT,IEN,PRCQ,A,C)=0,PAGE=1
9 S $P(LINE,"=",IOM)=""
10 U IO(0) S TRM=1 S:IO=IO(0) IOC=1
11 I $D(IO("Q")) S ZTRTN="START^PRCB2A",ZTDTH="OBLIGATIONS PENDING ACTION",ZTSAVE("IOC")=1,ZTSAVE("LINE")="",ZTSAVE("PRCQ")="",ZTSAVE("PAGE")=""
12 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G EXIT
13START ;Loop picks up only specific entries
14 S A="",A0="",A1="",A2="",B=0,C=" - Purchase Orders",D=""
15 D HDR,HDR1
16 S PRCQ="" F ZSTAT=10,15,20 QUIT:PRCQ S IEN="" F S IEN=$O(^PRC(442,"AI",ZSTAT,IEN)) Q:IEN'>0 D PRINT QUIT:PRCQ
17 I PRCQ=1 G EXIT
18 ;Loop through 2237s & 1358s looking for GFP entries with status=10
19 S IEN=0,IEN1=0,IEN2=0,B=0,C=" - General Post Fund 2237s & 1358s"
20 D ASK G:PRCQ EXIT D HDR2
21 F S IEN1=$O(^PRC(420,"AD",1,IEN1)),IEN2=0 Q:IEN1'>0 D G:PRCQ EXIT
22 . F S IEN2=$O(^PRC(420,"AD",1,IEN1,IEN2)),IEN=0 Q:IEN2'>0 S D=$P(^PRC(420,IEN1,1,IEN2,0),U,1) D Q:PRCQ
23 . . F S IEN=$O(^PRCS(410,"AN",D,IEN)) Q:IEN'>0 D Q:PRCQ
24 . . . S A=$G(^PRCS(410,IEN,3)) Q:A=""
25 . . . S A=$G(^PRCS(410,IEN,1)) Q:A="" S A=$P(A,U,1) Q:A=""
26 . . . S A0=$G(^PRCS(410,IEN,0)) Q:A0=""
27 . . . S A1=$G(^PRCS(410,IEN,10)) Q:A1=""
28 . . . I $P(A0,U,4)=1&($P(A1,U,4)=10) D PRINT2(1) Q ; form type 1358
29 . . . S A2=$G(^PRC(443,IEN,0)) Q:A2=""
30 . . . I $P(A1,U,3)=""&($P(A2,U,7)=10) D PRINT2(0) Q ; No PO#
31 I B=0 W !!,"NO GPF 2237s or 1358s to print"
32 E W !!,"(Note: '*' indicates transaction is a 1358. All others are 2237s.)",!
33 I PRCQ="" D EN^DDIOL("END OF REPORT")
34EXIT K ZSTAT,IEN,L1,POP,ZTDTH,ZTRTN,ZTSAVE,TRM,LINE,PAGE,PRCQ,A,A0,A1,A2,B,C,D
35 D ^%ZISC
36 Q
37HDR ;
38 U IO W @IOF W !,?70,"Page ",PAGE S PAGE=PAGE+1
39 W !,"IFCAP OBLIGATIONS PENDING ACTION REPORT",C
40 W !,?47,"PRINTED ON " D ^%D W " AT " D ^%T
41 Q
42HDR1 ;Purchase orders
43 W !,LINE,!,"P.O. NUMBER",?12,"FCP ",?18,"AMOUNT",?32,"DATE",?42,"STATUS",!,LINE,!
44 Q
45HDR2 ;GPF 2237s
46 W !,LINE,!,"TRANSACTION NUMBER",?22,"FCP ",?32,"AMOUNT",?45,"DATE",?55,"STATUS",!,LINE,!
47 Q
48PRINT ;
49 Q:'$D(^PRC(442,IEN,0))
50 I $Y+8>IOSL D ASK Q:PRCQ D HDR1
51 W !,$P(^PRC(442,+IEN,0),U,1),?12,$P($P(^(0),U,3)," "),?18,"$"_$J($P(^(0),U,15),9,2)
52 W:$D(^PRC(442,IEN,1)) ?32,$E($P(^(1),U,15),4,5)_"-"_$E($P(^(1),U,15),6,7)_"-"_$E($P(^(1),U,15),2,3),?42,$E($S($D(^PRCD(442.3,+$P(^PRC(442,+IEN,7),U,1),0)):$P(^(0),U,1),1:""),1,39)
53 Q
54PRINT2(X) ;
55 I $Y+8>IOSL D ASK Q:PRCQ D HDR2
56 W !,$P(A0,U,1)
57 I X=1 W "*"
58 W ?22,$P($P(^PRCS(410,IEN,3),U,1)," "),?28
59 I $D(^PRCS(410,IEN,4))=0 W "Bad record"
60 E W "$"_$J($P(^(4),U,8),9,2),?42,$E(A,4,5),"-",$E(A,6,7),"-",$E(A,2,3)
61 W ?52,$P(^PRCD(442.3,10,0),U,1)
62 S B=B+1
63 Q
64ASK ;
65 I B>0 W !!,"(Note: '*' indicates transaction is a 1358. All others are 2237s.)"
66 I $E(IOST,1,2)="C-" W !!,"Press <RET> to continue or '^' to quit. " R X:DTIME I '$T!(X="^") S PRCQ=1 Q
67 D HDR Q
68INFO ;routine provides Fiscal Service with a listing of all Purchase orders
69 ;from file 442, that have a Supply Status of 10,15,20. These numbers
70 ;reflect IEN from file 442.3
71 ;As of PRC*5*163, the routine also lists 2237s in General Post Funds
Note: See TracBrowser for help on using the repository browser.