source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCSFMS.m@ 619

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PRCSFMS ;WISC/KMB-FMS TRANSACTIONS FOR CP RUNNING BALANCE ;10/16/97 1315
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 PRCSP1A
5 ; find FMS transactions, for selected quarter, for CP
6 N FTST,ZIP,P18,P19,RPR,RPR1,CUTOFF,FMSTOT,LINE,STRING,RDATE1,FIRST,FINAL,AMT,TYPE,MINUS,OBL,REF,RECNO,P1,RECN1
7 S Z1=0,P1=0,U="^"
8 D NOW^%DTC S Y=% D DD^%DT S RDATE1=Y
9 S FMSTOT=0 S:'$D(PRCS("O")) PRCS("O")=0 S FINAL=PRCS("O"),STRING=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_+PRC("CP")
10 S MINUS="" S:'$D(PRCS("C")) PRCS("C")=0
11 S FIRST=PRCS("C")
12 S RECNO="" F S RECNO=$O(^PRCS(417,"C",STRING,RECNO)) Q:RECNO="" D Q:Z1=U
13 .I '$D(C1),P1=0 D HDR1
14 .I '$D(C1),IOSL-$Y<8 D HOLD1 Q:Z1=U
15 .S ZIP="",RPR1="",RECN1=$P(^PRCS(417,RECNO,0),"^",23)
16 .Q:RECN1="D"
17 .Q:RECN1="N"
18 .S AMT=$P(^PRCS(417,RECNO,0),"^",20),REF=$P(^(0),"^",22),OBL=$P(^(0),"^",18),TYPE=$P(^(0),"^",17)
19 .S P18=$P(^PRCS(417,RECNO,0),"^",18),P19=$P(^PRCS(417,RECNO,0),"^",19)
20 .S RPR="C"_P18_P19
21 .I TYPE="CC",$D(^PRCH(440.6,"B",RPR)) S RPR1=$O(^PRCH(440.6,"B",RPR,0))
22 .I $G(RPR1)'="" S FTST=$P($G(^PRCH(440.6,RPR1,0)),"^",16) S:FTST="N" ZIP="@"
23 .S CUTOFF=$P($G(^PRCS(417,RECNO,1)),"^") I CUTOFF'=1 S FIRST=FIRST-AMT
24 .I CUTOFF=1,TYPE'="CC",$E(OBL,4,7)'?4A S FIRST=FIRST-AMT
25 .S FINAL=FINAL-AMT
26 .I '$D(C1) S Y=$P(REF,".") D DD^%DT W !,Y
27 .I '$D(C1) W ?13,OBL,?32,TYPE,?40,$J(AMT,11,2),ZIP,?54,$J(FIRST,11,2)
28 .I '$D(C1) W ?68,$J(FINAL,11,2)
29 .S FMSTOT=FMSTOT+AMT
30 I FMSTOT<0 S MINUS="-",FMSTOT=-FMSTOT
31 I Z1'=U W !!,"FMS transaction total for this quarter: ",MINUS,"$"_$J(FMSTOT,0,2)
32 S L="",$P(L,"=",IOM)="=" W !,L S L=""
33 S PRCS("C")=FIRST,PRCS("O")=FINAL Q
34HOLD1 ;
35 Q:$D(C1)
36 G HDR1:$D(ZTQUEUED),HDR1:IO'=IO(0)
37 D:$E(IOST,1,2)="C-" CRT D:Z1'=U HDR1
38 Q
39HDR1 ;
40 S P1=1
41 S P=P+1 W @IOF W "Control Point Balance - ",Z(0)_" "_$E($P(PRC("CP")," ",2),1,10),?50,RDATE1,?73,"PAGE ",P
42 W !,?40,"FMS Transactions",!
43 W !,"TRANSMISSION",?32,"TRANS",?40,"TRANSACTION",?68,"UNOBLIG",!,"DATE",?13,"REFERENCE #",?32,"CODE",?40,"$ AMOUNT",?54,"CP BALANCE",?68,"BALANCE"
44 S L="",$P(L,"=",IOM)="=" W !,L S L="" Q
45NONE ; find PO with no 2237 for running balance
46 QUIT
47HOLD2 ;
48 G HDR2:$D(ZTQUEUED),HDR2:IO'=IO(0)
49 D:$E(IOST,1,2)="C-" CRT D:Z1'=U HDR2
50 Q
51HDR2 ;
52 S P1=1
53 S P=P+1 W @IOF W "Control Point Balance - ",Z(0)_" "_$E($P(PRC("CP")," ",2),1,10),?50,RDATE1,?73,"PAGE ",P
54 W !,?5,"__________PO TRANSACTIONS WITHOUT 2237______________",!
55 W !,"PO/",?20,"PO ",?33,"COMMITTED",?58,"OBL/CEIL",?68,"UNOBLIG",!,"OBL#",?20,"DATE",?33,"(EST) COST",?44,"CP BALANCE",?58,"$ AMOUNT",?68,"BALANCE"
56 S L="",$P(L,"=",IOM)="=" W !,L S L="" Q
57CRT W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U Q:Z1="" Q:Z1=U W "??" G CRT
Note: See TracBrowser for help on using the repository browser.