| 1 | PRCHRP6 ;WISC/KMB/CR FISCAL DAILY REVIEW ;7/09/98 10:34
|
|---|
| 2 | ;;5.1;IFCAP;**8**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | START ;
|
|---|
| 5 | N LINE1,LINE2,PONUM,STRING,LIN1,LIN2,AMT,AMT1,FLAG,STATUS,CP,VEND,USER,STATUS,TDATE,EDATE,FDATE,HDATE,DIR,ZP,P,X,Y,F1,F2,LINE3,TOT,XXZ,EX
|
|---|
| 6 | K ^TMP($J)
|
|---|
| 7 | W @IOF
|
|---|
| 8 | S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE")) Q:$G(X)="^"
|
|---|
| 9 | S DIR("A")="Enter beginning date",DIR("?")="Enter the first date for which you wish to see records"
|
|---|
| 10 | S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S FDATE=+Y W " ",Y(0)
|
|---|
| 11 | S DIR("A")="Enter ending date",DIR("?")="Enter the last date for which you wish to see records"
|
|---|
| 12 | S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S EDATE=+Y W " ",Y(0)
|
|---|
| 13 | I EDATE<FDATE W !,"Date range is incorrect." G START
|
|---|
| 14 | S DIR("A")="Do you want to see delivery orders",DIR(0)="Y^^" D ^DIR K DIR Q:Y<0 S FLAG=Y
|
|---|
| 15 | S %ZIS("B")="",%ZIS="MQ" D ^%ZIS Q:POP
|
|---|
| 16 | I $D(IO("Q")) S ZTRTN="DETAIL^PRCHRP6",ZTSAVE("*")="" D ^%ZTLOAD,^%ZISC Q
|
|---|
| 17 | D DETAIL,^%ZISC
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | DETAIL ;
|
|---|
| 21 | D NOW^%DTC,YX^%DTC S HDATE=Y
|
|---|
| 22 | S (P,EX)=1
|
|---|
| 23 | S ZP="" F S ZP=$O(^PRC(442,"F",25,ZP)) Q:ZP="" D DETAIL1
|
|---|
| 24 | I $G(FLAG)=1 S ZP="" F S ZP=$O(^PRC(442,"F",1,ZP)) Q:ZP="" D DETAIL1
|
|---|
| 25 | D WRITE
|
|---|
| 26 | K ^TMP($J)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | DETAIL1 ;
|
|---|
| 30 | S F1=$G(^PRC(442,ZP,0)),F2=$G(^PRC(442,ZP,1))
|
|---|
| 31 | I $D(PRC("SITE")) Q:$P(F1,"-")'=PRC("SITE")
|
|---|
| 32 | S Y=$P(F2,"^",15),CP=$P(F1,"^",3),CP=+$P(CP," ")
|
|---|
| 33 | Q:CP="" Q:Y<FDATE Q:Y>EDATE
|
|---|
| 34 | D DD^%DT S TDATE=Y
|
|---|
| 35 | S USER=$P(F2,"^",10),USER=$P($G(^VA(200,+USER,0)),"^"),VEND=$P(F2,"^"),VEND=$P($G(^PRC(440,+VEND,0)),"^"),AMT=$P(F1,"^",15)
|
|---|
| 36 | I VEND="SIMPLIFIED",$P($G(^PRC(442,ZP,24)),"^",2)'="" S VEND=$P($G(^PRC(442,ZP,24)),"^",2)
|
|---|
| 37 | S VEND=$E(VEND,1,25)
|
|---|
| 38 | S LINE1=TDATE_"^"_USER_"^"_VEND_"^"_AMT
|
|---|
| 39 | S PONUM=$P(F1,"^"),STATUS=$P($G(^PRC(442,ZP,7)),"^") Q:STATUS=1 Q:STATUS=45
|
|---|
| 40 | S:STATUS'="" STATUS=$P($G(^PRCD(442.3,STATUS,0)),"^"),STATUS=$E(STATUS,1,40)
|
|---|
| 41 | S LINE2=STATUS_"^"_PONUM
|
|---|
| 42 | S ^TMP($J,CP,ZP,1)=LINE1,^TMP($J,CP,ZP,2)=LINE2
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | WRITE ;
|
|---|
| 46 | U IO S P=1
|
|---|
| 47 | S STRING="PURCHASE CARD PO NUMBER" S:FLAG=1 STRING="TRANSACTION PO NUMBER"
|
|---|
| 48 | I '$D(^TMP($J)) S CP="" D HEADER W !!!!,?10,"*** NO RECORDS TO PRINT ***" Q
|
|---|
| 49 | S TOT=0,(CP,ZP)="" F S CP=$O(^TMP($J,CP)) Q:EX[U Q:CP="" D
|
|---|
| 50 | .D HEADER
|
|---|
| 51 | .F S ZP=$O(^TMP($J,CP,ZP)) Q:EX[U Q:ZP="" D
|
|---|
| 52 | ..S LINE1=^TMP($J,CP,ZP,1),LINE2=^TMP($J,CP,ZP,2) D
|
|---|
| 53 | ...W !,$P(LINE1,"^"),?15,$P(LINE1,"^",2),?40,$P(LINE1,"^",3) S AMT1=$P(LINE1,"^",4) W ?70,$J(AMT1,8,2)
|
|---|
| 54 | ...W !,$P(LINE2,"^"),?45,$P(LINE2,"^",2),!
|
|---|
| 55 | ...S TOT=TOT+AMT1
|
|---|
| 56 | ...I (IOSL-$Y)<5 D HOLD
|
|---|
| 57 | .I EX'[U W !,?25,"CONTROL POINT ",CP," SUBTOTAL: ",$J(TOT,0,2),! S TOT=0
|
|---|
| 58 | .I $E(IOST,1,2)'="P-",EX'[U W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ[U EX=U S:'$T EX=U W !
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | HOLD G HEADER:$E(IOST,1,2)="P-"!(IO'=IO(0)) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ["^" EX="^" S:'$T EX="^" D:EX'="^" HEADER
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | HEADER ;
|
|---|
| 65 | W @IOF
|
|---|
| 66 | W !,"FISCAL DAILY REVIEW REPORT",?42,HDATE,?70,"PAGE ",P,!
|
|---|
| 67 | W !,"PURCHASE DATE",?15,"BUYER",?40,"VENDOR",?72,"AMOUNT"
|
|---|
| 68 | W !,?3,"STATUS",?45,STRING
|
|---|
| 69 | W ! F I=1:1:10 W "--------"
|
|---|
| 70 | W !!,"CONTROL POINT: ",CP,!
|
|---|
| 71 | S P=P+1
|
|---|
| 72 | Q
|
|---|
