source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRP2.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: 3.1 KB
Line 
1PRCHRP2 ;WISC/KMB/CR UNPAID PC TRANSACTION BY FCP ;6/05/98 11:15
2 ;;5.1;IFCAP;**62**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;
5 N BDATE,EDATE,PODATE,PC1,ARR,XXZ,EX,CP,VEND,USER,STATUS,TDATE,EDATE,FDATE,DIR,ZP,P,X,Y,F1,F2,LINE3,TOT,PCNUM,ZTR,ZTR1
6 N AMT,AMT1,LINE1,LINE2,LSTATUS,PRCST,PRCSJ,ZIP,BOC,CC,CCREC,PP,QSTATUS
7 K ^TMP($J)
8 ;
9 W @IOF,!!,"Detailed Report of Unpaid PC Transactions by FCP"
10 ;
11DATE S DIR(0)="D",DIR("A")="P.O. DATE (BEGIN RANGE) ",DIR("B")="T-30"
12 D ^DIR Q:$D(DIRUT) S BDATE=Y
13 ;
14 S DIR("A")="P.O. DATE (END RANGE) ",DIR("B")="T"
15 D ^DIR Q:$D(DIRUT) S EDATE=Y
16 ;
17 I BDATE'<EDATE,BDATE'=EDATE D G DATE
18 . W !,"Please enter a valid date range",!
19 ;
20 W !,"Please select a device for printing this report.",!
21 ;
22 S %ZIS("B")="",%ZIS="MQ" D ^%ZIS Q:POP
23 ;
24 ;Queue the report
25 I $D(IO("Q")) D Q
26 . S ZTRTN="DETAIL^PRCHRP2"
27 . S ZTSAVE("BDATE")=""
28 . S ZTSAVE("EDATE")=""
29 . D ^%ZTLOAD,^%ZISC Q
30 ;
31 D DETAIL,^%ZISC Q
32 ;
33DETAIL ;
34 F ZTR=1,24,29,32,34,37,38,40,41,45,50,51 S ARR(ZTR)=""
35 U IO S U="^",(P,EX)=1,ZP="" F S ZP=$O(^PRC(442,"F",25,ZP)) Q:ZP="" D
36 .S ZTR1=+$P($G(^PRC(442,ZP,7)),"^",2) Q:ZTR1=""
37 .Q:$D(ARR(ZTR1))
38 .S F1=$G(^PRC(442,ZP,0)),F2=$G(^PRC(442,ZP,1)),LINE3=$G(^PRC(442,ZP,2,1,1,1,0))
39 .S (PODATE,Y)=$P(F2,"^",15)
40 .I PODATE<BDATE!(PODATE>EDATE) Q
41 .S STATUS=+$P($G(^PRC(442,ZP,7)),"^",1),LSTATUS=$P($G(^PRCD(442.3,STATUS,0)),"^",1)
42 .S PCNUM=$P(F1,"^"),CP=$P(F1,"^",3),CP=$P(CP," ")
43 .S ZTR1=+$P($G(^PRC(442,ZP,7)),"^",2) Q:$D(ARR(ZTR1))
44 .Q:CP=""
45 .S PC1=$P($G(^PRC(442,ZP,23)),"^",8) Q:PC1=""
46 .D DD^%DT S TDATE=Y
47 .S USER=$P($G(^PRC(440.5,PC1,0)),"^",8),USER=$P($G(^VA(200,+USER,0)),"^"),VEND=$P(F2,"^"),VEND=$P($G(^PRC(440,+VEND,0)),"^"),AMT=$P(F1,"^",15),VEND=$E(VEND,1,30)
48 .I VEND="SIMPLIFIED",$P($G(^PRC(442,ZP,24)),"^",2)'="" S VEND=$P($G(^PRC(442,ZP,24)),"^",2)
49 .S LINE1=CP_"^"_PCNUM_"^"_USER_"^"_VEND
50 .S CC=$P(F1,"^",5),BOC=$P($G(^PRC(442,ZP,2,1,0)),"^",4),BOC=$E(BOC,1,20)
51 .S LINE2=AMT_"^"_TDATE_"^"_CC_"^"_$E(BOC,1,30)
52 .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
53 ;
54WRITE ;
55 I '$D(^TMP($J)) S P=1 D HEADER W !!!!,?10,"*** NO RECORDS TO PRINT ***" Q
56 S (TOT,CP,ZP)="" F S CP=$O(^TMP($J,CP)) Q:EX[U Q:CP="" D
57 .F S ZP=$O(^TMP($J,CP,ZP)) Q:EX[U Q:ZP="" D
58 ..D:P=1 HEADER I (IOSL-$Y)<6 D HOLD Q:EX[U
59 ..S LINE1=^TMP($J,CP,ZP,1) W !,$P(LINE1,"^"),?6,$P(LINE1,"^",2),?25,$P(LINE1,"^",3),?50,$P(LINE1,"^",4)
60 ..S AMT1=$P(^TMP($J,CP,ZP,2),"^",1) W !,?3,$J(AMT1,0,2),?20,$P(^TMP($J,CP,ZP,2),"^",2),?36,$P(^TMP($J,CP,ZP,2),"^",3),?50,$P(^TMP($J,CP,ZP,2),"^",4)
61 ..W !,^TMP($J,CP,ZP,3),!,^TMP($J,CP,ZP,4),!
62 ..S TOT=TOT+AMT1
63 .I EX'[U W !,?40,"CONTROL POINT ",CP," SUBTOTAL: ",$J(TOT,0,2),! S TOT=0
64 QUIT
65 ;
66HOLD G HEADER:$E(IOST)="P"!(IO'=IO(0)) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ["^" EX=U S:'$T EX=U D:EX'=U HEADER Q
67 ;
68HEADER ;
69 W @IOF
70 W !,"DETAILED REPORT OF UNPAID PURCHASE CARD TRANSACTIONS BY FCP",?65,"PAGE: ",P
71 W !,"FCP",?6,"PC NUMBER",?25,"BUYER",?50,"VENDOR"
72 W !,?3,"AMOUNT",?20,"PURCHASE DATE",?36,"COST CENTER",?50,"BUDGET OBJECT CODE",!,"FIRST LINE ITEM DESCRIPTION",!,"STATUS"
73 W ! F I=1:1:10 W "--------"
74 S P=P+1 Q
Note: See TracBrowser for help on using the repository browser.