source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSACOST.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PSACOST ;BIR/JMB-Invoice Cost Summary ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
3 ;This routine prints the order number, invoice number, invoice date,
4 ;total invoice cost, total adjusted cost, and cost difference for a
5 ;specified invoice date range.
6 ;
7 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
8 I '$O(^PSD(58.811,"ADATE",0)) W !,"There are no invoices." G EXIT
9 S PSAOUT=0 D BDATE^PSAPV G:PSAOUT EXIT
10DEVICE ;Asks device & queueing info
11 K IO("Q"),%ZIS,IOP,POP S %ZIS="Q",%ZIS("B")=""
12 W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
13 I $D(IO("Q")) D G EXIT
14 .N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
15 .S ZTRTN="COMPILE^PSACOST",ZTDESC="Drug Acct. - Invoice Cost Summary Report"
16 .S:$D(PSABEG) ZTSAVE("PSABEG")="" S:$D(PSAEND) ZTSAVE("PSAEND")=""
17 .D ^%ZTLOAD
18 ;
19COMPILE ;Compiles the data into ^TMP("PSACOST",$J)
20 S PSAOUT=0,PSADATE=PSABEG
21 F S PSADATE=+$O(^PSD(58.811,"ADATE",PSADATE)) Q:'PSADATE!(PSADATE>PSAEND)!(PSAOUT) D
22 .S PSAIEN=0 F S PSAIEN=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN)) Q:'PSAIEN!(PSAOUT) D
23 ..Q:'$D(^PSD(58.811,PSAIEN,0)) S PSAORD=$P(^PSD(58.811,PSAIEN,0),"^"),(PSAIEN1,PSAOECST)=0
24 ..F S PSAIEN1=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN,PSAIEN1)) Q:'PSAIEN1!(PSAOUT) D
25 ...Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
26 ...S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0),PSAINV=$P(PSAIN,"^"),PSAINVDT=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3)
27 ...S (PSAAECST,PSAIECST)=0
28 ...S PSALINE=0 F S PSALINE=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:'PSALINE!(PSAOUT) D
29 ....Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
30 ....S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0) D LINE
31 ...S PSADIFF=PSAIECST-PSAAECST,PSAOECST=PSAOECST+PSAAECST
32 ...S ^TMP("PSACOST",$J,PSAORD,PSAINV)=PSAINVDT_"^"_$J(PSAIECST,$L(PSAIECST),2)_"^"_$J(PSAAECST,$L($P(PSAAECST,".")),2)_"^"_$J(PSADIFF,$L(PSADIFF),2)
33 ;
34ORDER S PSAORD="" F S PSAORD=$O(^TMP("PSACOST",$J,PSAORD)) Q:PSAORD="" D
35 .S (PSAACOST,PSADIFF,PSAICOST)=0,PSAINV=""
36 .F S PSAINV=$O(^TMP("PSACOST",$J,PSAORD,PSAINV)) Q:PSAINV="" D
37 ..S PSAICOST=PSAICOST+$P(^TMP("PSACOST",$J,PSAORD,PSAINV),"^",2),PSAACOST=PSAACOST+$P(^TMP("PSACOST",$J,PSAORD,PSAINV),"^",3),PSADIFF=PSADIFF+$P(^TMP("PSACOST",$J,PSAORD,PSAINV),"^",4)
38 .S ^TMP("PSACOST",$J,PSAORD)=$J(PSAICOST,$L(PSAICOST),2)_"^"_$J(PSAACOST,$L($P(PSAACOST,".")),2)_"^"_$J(PSADIFF,$L(PSADIFF),2)
39 ;
40PRINT ;Prints invoices' totals
41 S Y=PSAEND D DD^%DT S PSAENDX=Y K X,Y,%DT
42 S Y=PSABEG D DD^%DT S PSABEGX=Y K X,Y,%DT
43 D NOW^%DTC S PSARUN=%,PSARUN=$E(PSARUN,4,5)_"/"_$E(PSARUN,6,7)_"/"_$E(PSARUN,2,3)_"@"_$E($P(PSARUN,".",2),1,2)_":"_$E($P(PSARUN,".",2),3,4)
44 S PSAPG=0,PSASLN="",$P(PSASLN,"-",80)="" K Y D HDR
45 S PSAORD=$O(^TMP("PSACOST",$J,"")) I PSAORD="" W !!,"There is no invoice data in the file for the selected date range.",! D END^PSAPROC G EXIT
46 S PSAORD="" F S PSAORD=$O(^TMP("PSACOST",$J,PSAORD)) Q:PSAORD=""!(PSAOUT) D
47 .S PSAODIFF=$P(^TMP("PSACOST",$J,PSAORD),"^",2)
48 .I $Y+5>IOSL D HDR Q:PSAOUT
49 .W !,"ORDER#: "_PSAORD
50 .S PSAINV="" F S PSAINV=$O(^TMP("PSACOST",$J,PSAORD,PSAINV)) Q:PSAINV=""!(PSAOUT) D
51 ..S PSAINVDT=$P(^TMP("PSACOST",$J,PSAORD,PSAINV),"^"),PSAICOST=$P(^(PSAINV),"^",2),PSAACOST=$P(^(PSAINV),"^",3),PSADIFF=$P(^(PSAINV),"^",4)
52 ..I $Y+4>IOSL D HDR Q:PSAOUT
53 ..W !,PSAINV,?27,PSAINVDT,?39,$J(PSAICOST,9,2),?55,$J(PSAACOST,9,2),?71,$J(PSADIFF,7,2)
54 .I $Y+4>IOSL D HDR Q:PSAOUT
55 .S PSAOCOST=$P(^TMP("PSACOST",$J,PSAORD),"^"),PSAOACST=$P(^(PSAORD),"^",2),PSAODIFF=$P(^(PSAORD),"^",3)
56 .I PSAICOST'=PSAOCOST!(PSAACOST'=PSAOACST) W !,"ORDER TOTAL" W ?39,$J(PSAOCOST,9,2),?55,$J(PSAOACST,9,2),?69 W $J(PSAODIFF,9,2),!
57 .E W !
58 I $E(IOST,1,2)="C-" Q:PSAOUT D END^PSAPROC
59 E W @IOF
60 ;
61EXIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q"),^TMP("PSACOST",$J)
62 K %,%DT,%ZIS,PSAACOST,PSAAECST,PSABEG,PSABEGX,PSADATA,PSADATE,PSADIFF,PSADJ,PSADJP,PSADJQ,PSAEND,PSAENDX,PSAICOST,PSAIECST,PSAIEN
63 K PSAIEN1,PSAIN,PSAINV,PSAINVDT,PSALCOST,PSALINE,PSANODE,PSAOACST,PSAOCOST,PSAODIFF,PSAOECST,PSAORD,PSAOUT,PSAPG,PSAPRICE,PSARUN,PSASLN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
64 Q
65 ;
66LINE ;Get line item data
67 S PSALCOST=$P(PSADATA,"^",3)*$P(PSADATA,"^",5),PSAIECST=PSAIECST+PSALCOST
68PRICE S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
69 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSAPRICE=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)),PSADJP=PSAPRICE
70 I '$G(PSADJ) S PSAPRICE=$P(PSADATA,"^",5)
71QTY S PSADJQ=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
72 I $G(PSADJ) D
73 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
74 .S PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
75 .S PSAACOST=PSADJQ*PSAPRICE,PSAAECST=PSAAECST+PSAACOST
76 I '$G(PSADJQ) S PSAACOST=$P(PSADATA,"^",3)*PSAPRICE,PSAAECST=PSAAECST+PSAACOST
77 Q
78 ;
79HDR ;Report header
80 I $E(IOST,1,2)="C-" W:'PSAPG @IOF D:+PSAPG END^PSAPROC Q:PSAOUT
81 I $E(IOST)'="C",+PSAPG W @IOF
82 S PSAPG=PSAPG+1
83 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE "_PSAPG
84 W !?27,"INVOICE COST SUMMARY REPORT"
85 I $E(IOST)'="C" W !,"RUN: "_PSARUN,?27,PSABEGX_" - "_PSAENDX
86 E W !,?27,PSABEGX_" - "_PSAENDX
87 W !!?28,"INVOICE",?41,"INVOICE",?56,"ADJUSTED"
88 W !,"INVOICE#",?31,"DATE",?44,"COST",?60,"COST",?68,"DIFFERENCE",!,PSASLN
89 Q
Note: See TracBrowser for help on using the repository browser.