source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHRP8.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PRCHRP8 ;WISC/KMB/CR-PC STATISTICS REPORT ;7/16/98 14:55
2 ;;5.1;IFCAP;**8**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START ;
5 N C1,C2,C3,C4,C5,AMT,PC,P,PRC,ZP,CP,LCT,BOC,CNT,PDATE,TRAN,XXZ,EX,Y,YY,PCLCT,PCCNT,BB,AA,COUNT,FDATE,EDATE,PCN,GTOT,END,TDATE
6 N PCNUM,SEQNUM,CTR,CTR1,CPCNT,I,PRCRI,Z0,Z1,Z7,Z23,ZP1,ZIP,USER,%
7 K ^TMP($J)
8 W @IOF S PRCF("X")="S" D ^PRCFSITE Q:'$D(PRC("SITE"))
9 Q:$G(X)="^"
10 ;
11RANGE ;
12 S DIR("A")="Enter beginning date",DIR("?")="Enter the first date for which you wish to see records"
13 S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S FDATE=+Y W " ",Y(0)
14 S DIR("A")="Enter ending date",DIR("?")="Enter the last date for which you wish to see records"
15 S DIR(0)="D^^" D ^DIR K DIR Q:+Y<1 S EDATE=+Y W " ",Y(0)
16 I EDATE<FDATE W !,"Date range is incorrect." G RANGE
17 S %ZIS("B")="",%ZIS="MQ" D ^%ZIS Q:POP
18 I $D(IO("Q")) S ZTRTN="DETAIL^PRCHRP8",ZTSAVE("EDATE")="",ZTSAVE("FDATE")="",ZTSAVE("PRC*")="" D ^%ZTLOAD,^%ZISC Q
19 D DETAIL,^%ZISC Q
20 ;
21DETAIL ;
22 D NOW^%DTC S Y=% D DD^%DT S TDATE=Y
23 S GTOT=0,U="^",(COUNT,P,EX,CNT)=1
24 S CTR=FDATE F S CTR=$O(^PRC(442,"AB",CTR)) Q:+CTR=0 Q:CTR>EDATE D
25 .S CTR1=0 F S CTR1=$O(^PRC(442,"AB",CTR,CTR1)) Q:+CTR1=0 D
26 ..S ZP1=CTR1 S Z0=$G(^PRC(442,ZP1,0)),Z1=$G(^PRC(442,ZP1,1)),Z7=$P(Z0,"^",12) S:Z7="" Z7=0
27 ..I $D(PRC("SITE")) Q:$P(Z0,"-")'=PRC("SITE")
28 ..S SEQNUM=$P(Z0,"^")
29 ..S Z23=$G(^PRC(442,ZP1,23))
30 ..S (Y,YY)=$P(Z1,"^",15) Q:YY<FDATE Q:YY>EDATE
31 ..S CP=$P(Z0,"^",3),CP=+$P(CP," ") Q:CP=0
32 ..S:$G(AA(CP,1))="" AA(CP,1)=0 S AA(CP,1)=AA(CP,1)+1
33 ..S PC=$P(Z23,"^",8) Q:PC="" S PCNUM=$P($G(^PRC(440.5,PC,0)),"^") Q:PCNUM="" S PCN=$P($G(^PRC(440.5,PC,0)),"^",11),PCN=$E(PCN,1,28)
34 ..D DD^%DT S PDATE=Y
35 ..S:$G(AA(CP))="" AA(CP)=0 S:$G(AA(CP,2))="" AA(CP,2)=0
36 ..S AMT=$P(Z0,"^",15),LCT=$P($G(^PRCS(410,Z7,"IT",0)),"^",4),AA(CP,2)=AA(CP,2)+AMT,AA(CP)=AA(CP)+1,GTOT=GTOT+AMT
37 ..S USER=$P($G(^PRC(440.5,PC,0)),"^",8) Q:USER="" S USER=$P($G(^VA(200,USER,0)),"^") Q:USER=""
38 ..S ^TMP($J,CP,USER,PCNUM,YY,COUNT)=PCN_"^"_SEQNUM_"^"_LCT_"^"_AMT_"^"_PDATE,COUNT=COUNT+1
39 ..I '$D(BB(PCNUM)) S (BB(PCNUM),BB(PCNUM,1),BB(PCNUM,2))=0
40 ..S BB(PCNUM)=BB(PCNUM)+LCT,BB(PCNUM,1)=BB(PCNUM,1)+1,BB(PCNUM,2)=BB(PCNUM,2)+AMT
41 ;
42WRITE ;
43 U IO
44 I '$D(^TMP($J)) S C1="",C2="" D HEADER W !!!!,?10,"*** NO RECORDS TO PRINT ***" Q
45 S (C1,C2,C3,C4,C5)=0 F S C1=$O(^TMP($J,C1)) Q:EX[U Q:C1="" D
46 .F S C2=$O(^TMP($J,C1,C2)) Q:EX[U Q:C2="" D
47 ..D HEADER
48 ..F S C3=$O(^TMP($J,C1,C2,C3)) Q:EX[U Q:C3="" D
49 ...F S C4=$O(^TMP($J,C1,C2,C3,C4)) Q:EX[U Q:C4="" D
50 ....F S C5=$O(^TMP($J,C1,C2,C3,C4,C5)) Q:EX[U Q:C5="" D
51 .....S ZIP=^TMP($J,C1,C2,C3,C4,C5) W !,$P(ZIP,"^"),?30,$P(ZIP,"^",2),?43,$P(ZIP,"^",3) S AMT=$P(ZIP,"^",4) W ?52,$J(AMT,12,2),?67,$P(ZIP,"^",5)
52 .....I (IOSL-$Y)<8 D HOLD Q:EX[U
53 ...I EX'[U S PCCNT=BB(C3,2)/BB(C3,1),PCLCT=BB(C3)/BB(C3,1) W !!,"AVERAGE DOLLAR COST FOR CARD: $",$J(PCCNT,0,2),!," AVERAGE LINE COUNT FOR CARD: ",$J(PCLCT,0,2),!
54 ..I EX'[U S CPCNT=100*(AA(C1)/AA(C1,1)) W !!,"% OF PC ORDERS FOR CP ",C1,": ",$J(CPCNT,0,3),!,"PC ORDER COUNT: ",AA(C1),?30,"TOTAL ORDER COUNT: ",AA(C1,1),!," PC SUBTOTAL: ",$J(AA(C1,2),0,2)
55 ..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
56 I EX'[U W !?25,"STATION GRAND TOTAL - $",$J(GTOT,0,2)
57 K ^TMP($J)
58 QUIT
59 ;
60HOLD G HEADER:$E(IOST,1,2)="P-"!(IO'=IO(0)) W !,"Press return to continue, '^' to exit: " R XXZ:DTIME S:XXZ[U EX=U S:'$T EX=U D:EX'=U HEADER
61 QUIT
62 ;
63HEADER ;
64 W @IOF
65 W "PURCHASE CARD STATISTICS REPORT",?42,TDATE,?70,"PAGE ",P
66 W !,"PURCHASE CARD NAME",?30,"PO NUMBER",?43,"LINE ITEMS",?58,"AMOUNT",?67,"DATE PLACED"
67 W ! F I=1:1:8 W "----------"
68 W !!,"FCP: ",C1,?20,"BUYER: ",C2,!
69 S P=P+1 QUIT
Note: See TracBrowser for help on using the repository browser.