| 1 | PRCSFMS ;WISC/KMB-FMS TRANSACTIONS FOR CP RUNNING BALANCE ;10/16/97 1315
|
|---|
| 2 | V ;;5.1;IFCAP;**90**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | BEGIN ; 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
|
|---|
| 34 | HOLD1 ;
|
|---|
| 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
|
|---|
| 39 | HDR1 ;
|
|---|
| 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
|
|---|
| 45 | NONE ; find PO with no 2237 for running balance
|
|---|
| 46 | QUIT
|
|---|
| 47 | HOLD2 ;
|
|---|
| 48 | G HDR2:$D(ZTQUEUED),HDR2:IO'=IO(0)
|
|---|
| 49 | D:$E(IOST,1,2)="C-" CRT D:Z1'=U HDR2
|
|---|
| 50 | Q
|
|---|
| 51 | HDR2 ;
|
|---|
| 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
|
|---|
| 57 | CRT W !,"Press return to continue, uparrow (^) to exit: " R Z1:DTIME S:'$T Z1=U Q:Z1="" Q:Z1=U W "??" G CRT
|
|---|
