source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRP10.m@ 1119

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1PRCHRP10 ;WISC/KMB/CR HISTORY OF PURCHASE CARD TRANSACTIONS ;6/26/98 11:21
2 ;;5.1;IFCAP;**8**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4STR1 S FLAG=0
5STR2 S:$G(FLAG)="" FLAG=1
6START ;
7 N AMT,AMT1,ARR,BOC,CC,CP,CSTATUS,DIR,EDATE,EX,F1,F2,FDATE,GTOT,I,LINE1
8 N LINE2,LINE3,LINE4,LSTATUS,P,PAT,PC,POSTATUS,QSTATUS,STATUS,TDATE,TOT
9 N USER,VEND,X,XXZ,Y,ZP,ZTR,HDATE,PRC
10 K ^TMP($J),^TMP("CANC",$J)
11 W @IOF
12 S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
13 S DIR("A")="Enter beginning date",DIR("?")="Enter the first date for which you wish to see records"
14 S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S FDATE=+Y W " ",Y(0)
15 S DIR("A")="Enter ending date",DIR("?")="Enter the last date for which you want to see records"
16 S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S EDATE=+Y W " ",Y(0)
17 I EDATE<FDATE W !,"Date range is incorrect." G START
18 S DIR(0)="S^P:Paid;U:Unpaid;B:Both",DIR("A")="STATUS" D ^DIR K DIR Q:Y["^" S STATUS=Y
19 S:STATUS["P" STATUS="P" S:STATUS["U" STATUS="U" S:STATUS["B" STATUS=""
20 S %ZIS("B")="",%ZIS="MQ" D ^%ZIS Q:POP
21 I $D(IO("Q")) S ZTRTN="DETAIL^PRCHRP10",ZTSAVE("*")="" D ^%ZTLOAD,^%ZISC K FLAG Q
22 D DETAIL,^%ZISC K FLAG Q
23DETAIL ;
24 D NOW^%DTC S Y=$P(%,".") D DD^%DT S HDATE=Y
25 U IO S U="^",P=1,(EX,POSTATUS,ZP)=""
26 F I=24,29,32,34,37,38,40,41,50,51 S ARR(I)=""
27 F S ZP=$O(^PRC(442,"F",25,ZP)) Q:ZP="" D
28 .S PC=$P($G(^PRC(442,ZP,23)),"^",8) Q:PC=""
29 .I $G(FLAG)=1 I ($P($G(^PRC(440.5,+PC,0)),"^",10)'=DUZ)&($P($G(^PRC(440.5,+PC,0)),"^",9)'=DUZ) Q
30 .I $G(FLAG)=0 I $P($G(^PRC(440.5,+PC,0)),"^",8)'=DUZ QUIT
31 .S CSTATUS=$P($G(^PRC(442,ZP,7)),"^"),CSTATUS=$P($G(^PRCD(442.3,+CSTATUS,0)),"^",2)
32 .I STATUS="U" Q:$D(ARR(CSTATUS))
33 .I STATUS="P" Q:'$D(ARR(CSTATUS))
34 .S F1=$G(^PRC(442,ZP,0)),F2=$G(^PRC(442,ZP,1)),LINE3=$G(^PRC(442,ZP,2,1,1,1,0)),POSTATUS=$P($G(^PRC(442,ZP,7)),"^"),POSTATUS=$P($G(^PRCD(442.3,+POSTATUS,0)),"^",1)
35 .;Do not mix data from different stations
36 .I $D(PRC("SITE")) Q:$P(F1,"-",1)'=PRC("SITE")
37 .S Y=$P(F2,"^",15),CP=$P(F1,"^",3),CP=$P(CP," ")
38 .Q:CP="" Q:Y<FDATE Q:Y>EDATE
39 .D DD^%DT S TDATE=Y
40 .S USER=$P($G(^PRC(440.5,PC,0)),"^",8),USER=$E($P($G(^VA(200,+USER,0)),"^"),1,20),VEND=$P(F2,"^"),VEND=$P($G(^PRC(440,+VEND,0)),"^"),AMT=$P(F1,"^",15)
41 .I VEND="SIMPLIFIED",$P($G(^PRC(442,ZP,24)),"^",2)'="" S VEND=$P($G(^PRC(442,ZP,24)),"^",2)
42 .S VEND=$E(VEND,1,20)
43 .S PAT=$P(F1,"^")
44 .S LINE1=CP_"^"_PAT_"^"_TDATE_"^"_USER_"^"_VEND
45 .S CC=$P(F1,"^",5),BOC=$P($G(^PRC(442,ZP,2,1,0)),"^",4),BOC=$E(BOC,1,40)
46 .S LSTATUS=POSTATUS_"^"_CSTATUS
47 .S LINE2=AMT_"^"_CC_"^"_BOC
48 .S CP=+CP,^TMP($J,CP,ZP,1)=LINE1,^TMP($J,CP,ZP,2)=LINE2,^TMP($J,CP,ZP,3)=LINE3,^TMP($J,CP,ZP,4)=LSTATUS
49 ;
50WRITE ;
51 I '$D(^TMP($J)) S P=1 S:STATUS["P" STATUS="P" S:STATUS["U" STATUS="U" S:STATUS["B" STATUS="" D HEADER W !!!!,?10,"*** NO RECORDS TO PRINT ***" Q
52 S (GTOT,TOT,CP,ZP)="" F S CP=$O(^TMP($J,CP)) Q:CP="" Q:EX="^" D
53 .S TOT=0 F S ZP=$O(^TMP($J,CP,ZP)) Q:ZP="" Q:EX="^" D
54 ..D:P=1 HEADER
55 ..S LINE1=^TMP($J,CP,ZP,1) W !,$P(LINE1,"^"),?6,$P(LINE1,"^",2),?19,$P(LINE1,"^",3),?36,$P(LINE1,"^",4),?58,$P(LINE1,"^",5)
56 ..S AMT1=$P(^TMP($J,CP,ZP,2),"^",1) W !,?3,$J(AMT1,0,2),?18,$P(^TMP($J,CP,ZP,2),"^",2),?36,$P(^TMP($J,CP,ZP,2),"^",3)
57 ..W !,^TMP($J,CP,ZP,3),!
58 ..S LINE4=^TMP($J,CP,ZP,4) I +$P(LINE4,"^",2)'=45 W $P(LINE4,"^",1),!
59 ..I +$P(LINE4,"^",2)=45 S AMT1=0,^TMP("CANC",$J)=1 W $P(LINE4,"^",1),!
60 ..I (IOSL-$Y)<6 D HOLD Q:EX="^"
61 ..S TOT=TOT+AMT1,GTOT=GTOT+AMT1
62 .I EX'="^" W !,?30,"CONTROL POINT ",$P(LINE1,"^")," SUBTOTAL: ",$J(TOT,0,2),! S TOT=0
63 I GTOT'=0,EX'="^" W ?30,"TOTAL: ",$J(GTOT,0,2) W:$D(^TMP("CANC",$J)) !?30,"(EXCLUDES Cancelled Orders)"
64 K ^TMP($J),^TMP("CANC",$J)
65 QUIT
66 ;
67HOLD G HEADER:$E(IOST)="P"!(IO'=IO(0)) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ="^" EX="^" S:'$T EX="^" D:EX'="^" HEADER Q
68 ;
69HEADER ;
70 W @IOF
71 W !,"HISTORY OF PURCHASE CARD TRANSACTIONS REPORT - " W $S(STATUS="U":"UNPAID",STATUS="P":"PAID",1:"ALL")
72 W ?56,HDATE,?70,"PAGE ",P
73 W !,"FCP",?6,"PO NUMBER",?19,"PURCHASE DATE",?36,"BUYER",?58,"VENDOR"
74 W !,?3,"AMOUNT",?18,"COST CENTER",?36,"BUDGET OBJECT CODE",!,"FIRST LINE ITEM DESCRIPTION",!,"STATUS"
75 W ! F I=1:1:10 W "--------"
76 S P=P+1 Q
Note: See TracBrowser for help on using the repository browser.