PSACOST ;BIR/JMB-Invoice Cost Summary ;7/23/97
 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
 ;This routine prints the order number, invoice number, invoice date,
 ;total invoice cost, total adjusted cost, and cost difference for a
 ;specified invoice date range.
 ;
 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
 I '$O(^PSD(58.811,"ADATE",0)) W !,"There are no invoices." G EXIT
 S PSAOUT=0 D BDATE^PSAPV G:PSAOUT EXIT
DEVICE ;Asks device & queueing info
 K IO("Q"),%ZIS,IOP,POP S %ZIS="Q",%ZIS("B")=""
 W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
 I $D(IO("Q")) D  G EXIT
 .N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
 .S ZTRTN="COMPILE^PSACOST",ZTDESC="Drug Acct. - Invoice Cost Summary Report"
 .S:$D(PSABEG) ZTSAVE("PSABEG")="" S:$D(PSAEND) ZTSAVE("PSAEND")=""
 .D ^%ZTLOAD
 ;
COMPILE ;Compiles the data into ^TMP("PSACOST",$J)
 S PSAOUT=0,PSADATE=PSABEG
 F  S PSADATE=+$O(^PSD(58.811,"ADATE",PSADATE)) Q:'PSADATE!(PSADATE>PSAEND)!(PSAOUT)  D
 .S PSAIEN=0 F  S PSAIEN=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN)) Q:'PSAIEN!(PSAOUT)  D
 ..Q:'$D(^PSD(58.811,PSAIEN,0))  S PSAORD=$P(^PSD(58.811,PSAIEN,0),"^"),(PSAIEN1,PSAOECST)=0
 ..F  S PSAIEN1=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN,PSAIEN1)) Q:'PSAIEN1!(PSAOUT)  D
 ...Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
 ...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)
 ...S (PSAAECST,PSAIECST)=0
 ...S PSALINE=0 F  S PSALINE=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:'PSALINE!(PSAOUT)  D
 ....Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
 ....S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0) D LINE
 ...S PSADIFF=PSAIECST-PSAAECST,PSAOECST=PSAOECST+PSAAECST
 ...S ^TMP("PSACOST",$J,PSAORD,PSAINV)=PSAINVDT_"^"_$J(PSAIECST,$L(PSAIECST),2)_"^"_$J(PSAAECST,$L($P(PSAAECST,".")),2)_"^"_$J(PSADIFF,$L(PSADIFF),2)
 ;
ORDER S PSAORD="" F  S PSAORD=$O(^TMP("PSACOST",$J,PSAORD)) Q:PSAORD=""  D
 .S (PSAACOST,PSADIFF,PSAICOST)=0,PSAINV=""
 .F  S PSAINV=$O(^TMP("PSACOST",$J,PSAORD,PSAINV)) Q:PSAINV=""  D
 ..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)
 .S ^TMP("PSACOST",$J,PSAORD)=$J(PSAICOST,$L(PSAICOST),2)_"^"_$J(PSAACOST,$L($P(PSAACOST,".")),2)_"^"_$J(PSADIFF,$L(PSADIFF),2)
 ;
PRINT ;Prints invoices' totals
 S Y=PSAEND D DD^%DT S PSAENDX=Y K X,Y,%DT
 S Y=PSABEG D DD^%DT S PSABEGX=Y K X,Y,%DT
 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)
 S PSAPG=0,PSASLN="",$P(PSASLN,"-",80)="" K Y D HDR
 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
 S PSAORD="" F  S PSAORD=$O(^TMP("PSACOST",$J,PSAORD)) Q:PSAORD=""!(PSAOUT)  D
 .S PSAODIFF=$P(^TMP("PSACOST",$J,PSAORD),"^",2)
 .I $Y+5>IOSL D HDR Q:PSAOUT
 .W !,"ORDER#: "_PSAORD
 .S PSAINV="" F  S PSAINV=$O(^TMP("PSACOST",$J,PSAORD,PSAINV)) Q:PSAINV=""!(PSAOUT)  D
 ..S PSAINVDT=$P(^TMP("PSACOST",$J,PSAORD,PSAINV),"^"),PSAICOST=$P(^(PSAINV),"^",2),PSAACOST=$P(^(PSAINV),"^",3),PSADIFF=$P(^(PSAINV),"^",4)
 ..I $Y+4>IOSL D HDR Q:PSAOUT
 ..W !,PSAINV,?27,PSAINVDT,?39,$J(PSAICOST,9,2),?55,$J(PSAACOST,9,2),?71,$J(PSADIFF,7,2)
 .I $Y+4>IOSL D HDR Q:PSAOUT
 .S PSAOCOST=$P(^TMP("PSACOST",$J,PSAORD),"^"),PSAOACST=$P(^(PSAORD),"^",2),PSAODIFF=$P(^(PSAORD),"^",3)
 .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),!
 .E  W !
 I $E(IOST,1,2)="C-" Q:PSAOUT  D END^PSAPROC
 E  W @IOF
 ;
EXIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q"),^TMP("PSACOST",$J)
 K %,%DT,%ZIS,PSAACOST,PSAAECST,PSABEG,PSABEGX,PSADATA,PSADATE,PSADIFF,PSADJ,PSADJP,PSADJQ,PSAEND,PSAENDX,PSAICOST,PSAIECST,PSAIEN
 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
 Q
 ;
LINE ;Get line item data
 S PSALCOST=$P(PSADATA,"^",3)*$P(PSADATA,"^",5),PSAIECST=PSAIECST+PSALCOST
PRICE S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
 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
 I '$G(PSADJ) S PSAPRICE=$P(PSADATA,"^",5)
QTY S PSADJQ=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
 I $G(PSADJ) D
 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
 .S PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
 .S PSAACOST=PSADJQ*PSAPRICE,PSAAECST=PSAAECST+PSAACOST
 I '$G(PSADJQ) S PSAACOST=$P(PSADATA,"^",3)*PSAPRICE,PSAAECST=PSAAECST+PSAACOST
 Q
 ;
HDR ;Report header
 I $E(IOST,1,2)="C-" W:'PSAPG @IOF D:+PSAPG END^PSAPROC Q:PSAOUT
 I $E(IOST)'="C",+PSAPG W @IOF
 S PSAPG=PSAPG+1
 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE "_PSAPG
 W !?27,"INVOICE COST SUMMARY REPORT"
 I $E(IOST)'="C" W !,"RUN: "_PSARUN,?27,PSABEGX_" - "_PSAENDX
 E  W !,?27,PSABEGX_" - "_PSAENDX
 W !!?28,"INVOICE",?41,"INVOICE",?56,"ADJUSTED"
 W !,"INVOICE#",?31,"DATE",?44,"COST",?60,"COST",?68,"DIFFERENCE",!,PSASLN
 Q