source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSQR.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1PRCSQR ;WISC/KMB-QUARTERLY REPORT ;10/17/94 9:00
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;
5 N TY,PONUM,OBLAMT,ESTAMT,TOTAL,Z D EN1^PRCSUT G W2:'$D(PRC("SITE")),EXIT:Y<0 S PRCSZ=Z
6 K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS G EXIT:POP
7 I $D(IO("Q")) S ZTRTN="PROCESS^PRCSQR",ZTDESC="ESTIMATED BALANCE REPORT",ZTSAVE("TY")="",ZTSAVE("PRC*")="" D ^%ZTLOAD D ^%ZISC D W1 G EXIT:%'=1 W !! G START
8 D PROCESS D ^%ZISC D W1 G EXIT:%'=1 W @IOF G START
9PROCESS ;
10 U IO S Z1="",P=0 D NOW^%DTC S Y=% D DD^%DT S TY=Y
11 S (N,Z,Z(0))=PRCSZ,Z(0)=Z(0)_"-"
12 S PRCS("PRE")=0,PRCS("O")=0,PRCS("C")=0,N(1)="" D HDR
13 F I=0:1 S N=$O(^PRCS(410,"B",N)) Q:N=""!(N'[Z(0)) S N(1)=$O(^PRCS(410,"B",N,0)) Q:N(1)="" D PROCESS1 Q:Z1=U
14 Q:Z1=U S L="",$P(L,"=",IOM)="=" W !,L S L="" H 2 D NONE^PRCSFMS1 Q:Z1=U
15 H 2 D ^PRCSFMS1 Q:Z1=U
16 S REPORT2=1 D WRITE,T2^PRCSAPP1
17 K REPORT2,PRCS QUIT
18 ;
19PROCESS1 ;
20 N PRCA,PRCB,PRCF,PRCG,PRCH,PRCJ,PRCACP
21 S TOTAL1="" S:$D(^PRCS(410,N(1),4)) TOTAL1=^(4) S X=^(0),Z=$P(X,"^",2),PONUM=$P(TOTAL1,"^",5),ADJAMT=$P(TOTAL1,"^",6),ESTAMT=$P(TOTAL1,"^",8),OBLAMT=$P(TOTAL1,"^",3),PRCA=$G(^(4)),PRCB=$G(^(7)),PRCH="*^*",PRCACP=$P(PRCA,"^",14)
22 S PRCF=$G(^PRCS(410,N(1),0)),PRCG=$P(PRCF,"^",2),PRCF=$P(PRCF,"^",4)
23 I PRCG="A",PRCF=1 S:$P(PRCB,"^",6)]"" PRCS("C")=PRCS("C")-ESTAMT,$P(PRCH,"^")="" S:$P(PRCA,"^",10)]"" PRCS("O")=PRCS("O")-OBLAMT,$P(PRCH,"^",2)="" S PRCS("PRE")=PRCS("PRE")-ESTAMT D PROCESS2 Q
24 I PRCG="O" D
25 .S:$P(PRCB,"^",6)]"" PRCS("C")=PRCS("C")-ESTAMT,$P(PRCH,"^")=""
26 .S:$P(PRCA,"^",10)]"" PRCS("O")=PRCS("O")-OBLAMT,$P(PRCH,"^",2)=""
27 .S PRCS("PRE")=PRCS("PRE")-ESTAMT
28 .S PRCJ=$O(^PRC(442,"B",PRC("SITE")_"-"_PONUM,0)) I +PRCJ'=0,$P($G(^PRC(442,PRCJ,0)),"^",2)=25 S PRCH="@^@"
29 I PRCG="C" S PRCH="",PRCS("C")=PRCS("C")+ESTAMT,PRCS("O")=PRCS("O")+OBLAMT
30 I PRCG="A" S PRCH="",PRCS("C")=PRCS("C")-ESTAMT S:PRCACP'="Y" PRCS("O")=PRCS("O")-OBLAMT S PRCS("PRE")=PRCS("PRE")-ESTAMT
31 I PRCG="CA" S PRCH="#^#"
32 D PROCESS2
33 QUIT
34 ;
35PROCESS2 ;
36 D:IOSL-$Y<3 HOLD Q:Z1=U S X1=$S(Z="C":"CEI",Z="O":"OBL",Z="A":"ADJ",Z="CA":"CAN",1:"")
37 S:PRCF=5 X1="ISS"
38 W !,$P($P(X,"^"),"-",5),?6,X1,?11,PONUM
39 W ?19,$J(ESTAMT,10,2),$P(PRCH,"^",1)
40 I OBLAMT W ?29,$J(OBLAMT,10,2),$P(PRCH,"^",2)
41 S T(1)=$P($G(^PRCS(410,N(1),1)),"^",4),T(2)=$P($G(^PRCS(410,N(1),4)),"^",4),T(3)=$P($G(^PRCS(410,N(1),9)),"^",3) S:Z="A" T(2)=$P($G(^PRCS(410,N(1),4)),"^",7)
42 F I=1:1:3 S Y=T(I) D DD^%DT S PLACE=(I*12)+31,PLACE=PLACE+2 W ?PLACE,Y
43 W !,?29,$J(PRCS("PRE"),10,2)
44 W ?44,$J(PRCS("C"),10,2)
45 W ?59,$J(PRCS("O"),10,2)
46 W !,$P($G(^PRCS(410,N(1),2)),"^")
47 N STR S STR=$P($G(^PRCS(410,N(1),"IT",1,1,1,0)),"^") W ?40,$E(STR,1,40)
48 W !,$G(^PRCS(410,N(1),"CO",1,0)),!
49 QUIT
50 ;
51HOLD ;
52 G HDR:$E(IOST,1,2)'="C-" W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U D:Z1'=U HDR Q
53HDR ;
54 S P=P+1 W @IOF,"QUARTERLY REPORT - ",Z(0)_" "_$E($P(PRC("CP")," ",2),1,15),?53,TY,?76,"PAGE: ",P
55 W !,?21,"TRANS $",?33,"OBL/CEIL",?45,"DATE",?57,"DATE",?69,"DATE",!,"SEQ#",?6,"TYPE",?11,"PO/OBL#",?21,"AMOUNT",?33,"$ AMOUNT",?45,"REQ.",?57,"OBL.",?69,"REC'D."
56 W !,?29,"CONTROL POINT",?44,"UNCOMMITTED",?59,"UNOBLIGATED",!,?29,"REQUEST TOTAL",?44,"BALANCE",?59,"BALANCE"
57 W !,"VENDOR",?40,"FIRST LINE DESCRIPTION",!,"COMMENT"
58 S L="",$P(L,"-",IOM)="-" W !,L S L="" Q
59WRITE ;
60 S (SIGN(1),SIGN(2),SIGN(3))="$" S J=1 F I="PRE","C","O" S:PRCS(I)<0 PRCS(I)=-PRCS(I),SIGN(J)="-$" S J=J+1
61 W !!,"Total Request Amount: ",SIGN(1)_$J(PRCS("PRE"),0,2),!,"Control Point Official's Balance: ",SIGN(2)_$J(PRCS("C"),0,2),!,"Fiscal's Unobligated Balance: ",SIGN(3)_$J(PRCS("O"),0,2),! H 4
62 S J=1 F I="PRE","C","O" S:SIGN(J)="-$" PRCS(I)=-PRCS(I) S J=J+1
63 QUIT
64W1 ;
65 W !,"Would you like to run another quarterly balance report" S %=2 D YN^DICN G W1:%=0 Q
66W2 ;
67 W !,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
68EXIT K X,SIGN QUIT
Note: See TracBrowser for help on using the repository browser.