source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSFMS1.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PRCSFMS1 ;WISC/KMB-FMS TRANSACTIONS FOR CP QUARTERLY REPORT ;10-17-94 11:05
2V ;;5.1;IFCAP;**90**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4BEGIN ; this routine is called from PRCSQR
5 ; find FMS transactions, for selected quarter, for CP
6 N Z1,FMSTOT,LINE,STRING,RDATE1,FIRST,FINAL,AMT,TYPE,MINUS,OBL,REF,RECNO,P1,PRCSAPP S (P1,Z1)=0
7 D NOW^%DTC S Y=% D DD^%DT S RDATE1=Y
8 S FMSTOT=0 S:'$D(PRCS("O")) PRCS("O")=0 S FINAL=PRCS("O"),STRING=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_+PRC("CP")
9 S:'$D(PRCS("PRE")) PRCS("PRE")=0 S PRCSAPP=PRCS("PRE")
10 S MINUS="" S:'$D(PRCS("C")) PRCS("C")=0 S FIRST=PRCS("C")
11 S RECNO="" F S RECNO=$O(^PRCS(417,"C",STRING,RECNO)) Q:RECNO="" D Q:Z1=U
12 .I P1=0 D HDR1
13 .I IOSL-$Y<8 D HOLD1 Q:Z1=U
14 .S AMT=$P(^PRCS(417,RECNO,0),"^",20),REF=$P(^(0),"^",22),OBL=$P(^(0),"^",18),TYPE=$P(^(0),"^",17)
15 .S PRCSAPP=PRCSAPP-AMT,FIRST=FIRST-AMT,FINAL=FINAL-AMT
16 .S Y=$P(REF,".") D DD^%DT W !,Y
17 .W ?13,OBL,?24,TYPE,?32,$J(AMT,0,2),?42,$J(PRCSAPP,0,2),?54,$J(FIRST,0,2)
18 .W ?68,$J(FINAL,0,2)
19 .S FMSTOT=FMSTOT+AMT
20 I FMSTOT<0 S MINUS="-",FMSTOT=-FMSTOT
21 I Z1'=U W !!,"FMS transaction total for this quarter: ",MINUS,"$"_$J(FMSTOT,0,2)
22 S L="",$P(L,"=",IOM)="=" W !,L S L=""
23 S PRCS("PRE")=PRCSAPP,PRCS("C")=FIRST,PRCS("O")=FINAL Q
24HOLD1 ;
25 Q:$D(C1)
26 G HDR1:$D(ZTQUEUED),HDR1:IO'=IO(0) W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U D:Z1'=U HDR1 Q
27HDR1 ;
28 S P1=1
29 S P=P+1 W @IOF W "QUARTERLY REPORT "_"- "_Z(0)_" "_$E($P(PRC("CP")," ",2),1,10),?50,RDATE1,?73,"PAGE ",P
30 W !,?40,"FMS Transactions",!
31 W !,"TRANS",?32,"TRANS",?42,"CONTROL PT.",?54,"UNCOMMITTED",?68,"UNOBLIGATED",!,"DATE",?13,"REF #",?24,"TYPE",?32,"AMOUNT",?42,"REQ TOT",?54,"BALANCE",?68,"BALANCE"
32 S L="",$P(L,"=",IOM)="=" W !,L S L="" Q
33NONE ; find PO with no 2237 for running balance
34 N PRCSAPP,P1,Y,RDATE,TOTAL,AMT,AMT1,PI,REC,FIRST,FINAL,NET,STRING,NONNET
35 N YEAR,L,RDATE1,CP,LINE,MINUS,TYPR,RQTR
36 D NOW^%DTC S Y=% D DD^%DT S RDATE1=Y
37 S CP=$P(PRC("CP")," "),REC="",TOTAL=0,P1=0,Z1=""
38 S STRING="2^2^2^3^3^3^4^4^4^1^1^1"
39 S:'$D(PRCS("O")) PRCS("O")=0 S FINAL=PRCS("O")
40 S:'$D(PRCS("PRE")) PRCS("PRE")=0 S PRCSAPP=PRCS("PRE")
41 S MINUS="" S:'$D(PRCS("C")) PRCS("C")=0 S FIRST=PRCS("C")
42 S PRCC=+$$YEAR^PRC0C(PRC("FY"))
43 S PRCE=$$QTRDATE^PRC0D(PRCC,PRC("QTR"))
44 S REC=$P(PRCE,"^",8)+100,REC=$$DATE^PRC0C(REC,"H")
45 S PRCG=$$QTRDATE^PRC0D(+REC,$P(REC,"^",2))
46 S PRCE=$P(PRCE,"^",7)-1,PRCG=$P(PRCG,"^",7)-1
47 F S PRCE=$O(^PRC(442,"AB",PRCE)) QUIT:PRCE>PRCG!'PRCE D Q:Z1=U
48 . S REC=0 F S REC=$O(^PRC(442,"AB",PRCE,REC)) QUIT:'REC S PRCF=$G(^PRC(442,REC,0)) I $P(PRCF,"^",12)="",+PRCF=PRC("SITE"),+$P(PRCF,"^",3)=+PRC("CP") D:$P($G(^(12)),"^",2)]"" Q:Z1=U
49 ..S AMT=$P($G(^PRC(442,REC,0)),"^",16) S:AMT="" AMT=0
50 ..S:$P($G(^PRC(442,REC,7)),"^",2)=45 AMT=0
51 ..I $P($G(^PRC(442,REC,0)),"^",2)=25,$P($G(^PRC(442,REC,7)),"^",2)=22 S AMT=0
52 ..S PRCSAPP=PRCSAPP-AMT,FIRST=FIRST-AMT,FINAL=FINAL-AMT,TOTAL=TOTAL+AMT
53 ..D:P1=0 HDR2
54 ..W !,$P(^PRC(442,REC,0),"^")
55 ..S Y=$P(^PRC(442,REC,1),"^",15) D DD^%DT W ?15,Y
56 ..W ?30,$J(AMT,0,2),?41,$J(PRCSAPP,0,2),?55,$J(FIRST,0,2),?69,$J(FINAL,0,2)
57 ..Q:Z1=U I IOSL-$Y<8 D HOLD2 Q:Z1=U
58 .. QUIT
59 . QUIT
60 S PRCS("C")=FIRST,PRCS("O")=FINAL,PRCS("PRE")=PRCSAPP
61 I TOTAL<0 S MINUS="-",TOTAL=-TOTAL
62 I Z1'=U W !!,"PO transaction (no 2237) total for this quarter: ",MINUS,"$",$J(TOTAL,0,2)
63 S L="",$P(L,"=",IOM)="=" W !,L S L="" QUIT
64HOLD2 ;
65 Q:$D(C1)
66 G HDR2:$D(ZTQUEUED),HDR2:IO'=IO(0) W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U D:Z1'=U HDR2 Q
67HDR2 ;
68 S P1=1
69 S P=P+1 W @IOF W "QUARTERLY REPORT "_Z(0)_" "_$E($P(PRC("CP")," ",2),1,10),?50,RDATE1,?73,"PAGE ",P
70 W !,?5,"__________PO TRANSACTIONS WITHOUT 2237______________",!
71 W !,"PO/",?15,"PO ",?30,"OBLIGATED",?41,"CONTROL PT.",?55,"UNCOMMITTED",?69,"UNOBLIGATED",!,"OBL#",?15,"DATE",?30,"AMOUNT",?42,"REQ TOT",?55,"BALANCE",?69,"BALANCE"
72 S L="",$P(L,"=",IOM)="=" W !,L S L="" Q
Note: See TracBrowser for help on using the repository browser.