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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSACOST 5436 printed Nov 22, 2024@16:59:14 Page 2
PSACOST ;BIR/JMB-Invoice Cost Summary ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15**; 10/24/97
+2 ;This routine prints the order number, invoice number, invoice date,
+3 ;total invoice cost, total adjusted cost, and cost difference for a
+4 ;specified invoice date range.
+5 ;
+6 IF '$DATA(^XUSEC("PSA ORDERS",DUZ))
WRITE !,"You do not hold the key to enter the option."
QUIT
+7 IF '$ORDER(^PSD(58.811,"ADATE",0))
WRITE !,"There are no invoices."
GOTO EXIT
+8 SET PSAOUT=0
DO BDATE^PSAPV
if PSAOUT
GOTO EXIT
DEVICE ;Asks device & queueing info
+1 KILL IO("Q"),%ZIS,IOP,POP
SET %ZIS="Q"
SET %ZIS("B")=""
+2 WRITE !
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR OUTPUT PRINTED!"
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
+5 SET ZTRTN="COMPILE^PSACOST"
SET ZTDESC="Drug Acct. - Invoice Cost Summary Report"
+6 if $DATA(PSABEG)
SET ZTSAVE("PSABEG")=""
if $DATA(PSAEND)
SET ZTSAVE("PSAEND")=""
+7 DO ^%ZTLOAD
End DoDot:1
GOTO EXIT
+8 ;
COMPILE ;Compiles the data into ^TMP("PSACOST",$J)
+1 SET PSAOUT=0
SET PSADATE=PSABEG
+2 FOR
SET PSADATE=+$ORDER(^PSD(58.811,"ADATE",PSADATE))
if 'PSADATE!(PSADATE>PSAEND)!(PSAOUT)
QUIT
Begin DoDot:1
+3 SET PSAIEN=0
FOR
SET PSAIEN=+$ORDER(^PSD(58.811,"ADATE",PSADATE,PSAIEN))
if 'PSAIEN!(PSAOUT)
QUIT
Begin DoDot:2
+4 if '$DATA(^PSD(58.811,PSAIEN,0))
QUIT
SET PSAORD=$PIECE(^PSD(58.811,PSAIEN,0),"^")
SET (PSAIEN1,PSAOECST)=0
+5 FOR
SET PSAIEN1=+$ORDER(^PSD(58.811,"ADATE",PSADATE,PSAIEN,PSAIEN1))
if 'PSAIEN1!(PSAOUT)
QUIT
Begin DoDot:3
+6 if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
QUIT
+7 SET PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
SET PSAINV=$PIECE(PSAIN,"^")
SET PSAINVDT=$EXTRACT(PSADATE,4,5)_"/"_$EXTRACT(PSADATE,6,7)_"/"_$EXTRACT(PSADATE,2,3)
+8 SET (PSAAECST,PSAIECST)=0
+9 SET PSALINE=0
FOR
SET PSALINE=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE))
if 'PSALINE!(PSAOUT)
QUIT
Begin DoDot:4
+10 if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
QUIT
+11 SET PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
DO LINE
End DoDot:4
+12 SET PSADIFF=PSAIECST-PSAAECST
SET PSAOECST=PSAOECST+PSAAECST
+13 SET ^TMP("PSACOST",$JOB,PSAORD,PSAINV)=PSAINVDT_"^"_$JUSTIFY(PSAIECST,$LENGTH(PSAIECST),2)_"^"_$JUSTIFY(PSAAECST,$LENGTH($PIECE(PSAAECST,".")),2)_"^"_$JUSTIFY(PSADIFF,$LENGTH(PSADIFF),2)
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;
ORDER SET PSAORD=""
FOR
SET PSAORD=$ORDER(^TMP("PSACOST",$JOB,PSAORD))
if PSAORD=""
QUIT
Begin DoDot:1
+1 SET (PSAACOST,PSADIFF,PSAICOST)=0
SET PSAINV=""
+2 FOR
SET PSAINV=$ORDER(^TMP("PSACOST",$JOB,PSAORD,PSAINV))
if PSAINV=""
QUIT
Begin DoDot:2
+3 SET PSAICOST=PSAICOST+$PIECE(^TMP("PSACOST",$JOB,PSAORD,PSAINV),"^",2)
SET PSAACOST=PSAACOST+$PIECE(^TMP("PSACOST",$JOB,PSAORD,PSAINV),"^",3)
SET PSADIFF=PSADIFF+$PIECE(^TMP("PSACOST",$JOB,PSAORD,PSAINV),"^",4)
End DoDot:2
+4 SET ^TMP("PSACOST",$JOB,PSAORD)=$JUSTIFY(PSAICOST,$LENGTH(PSAICOST),2)_"^"_$JUSTIFY(PSAACOST,$LENGTH($PIECE(PSAACOST,".")),2)_"^"_$JUSTIFY(PSADIFF,$LENGTH(PSADIFF),2)
End DoDot:1
+5 ;
PRINT ;Prints invoices' totals
+1 SET Y=PSAEND
DO DD^%DT
SET PSAENDX=Y
KILL X,Y,%DT
+2 SET Y=PSABEG
DO DD^%DT
SET PSABEGX=Y
KILL X,Y,%DT
+3 DO NOW^%DTC
SET PSARUN=%
SET PSARUN=$EXTRACT(PSARUN,4,5)_"/"_$EXTRACT(PSARUN,6,7)_"/"_$EXTRACT(PSARUN,2,3)_"@"_$EXTRACT($PIECE(PSARUN,".",2),1,2)_":"_$EXTRACT($PIECE(PSARUN,".",2),3,4)
+4 SET PSAPG=0
SET PSASLN=""
SET $PIECE(PSASLN,"-",80)=""
KILL Y
DO HDR
+5 SET PSAORD=$ORDER(^TMP("PSACOST",$JOB,""))
IF PSAORD=""
WRITE !!,"There is no invoice data in the file for the selected date range.",!
DO END^PSAPROC
GOTO EXIT
+6 SET PSAORD=""
FOR
SET PSAORD=$ORDER(^TMP("PSACOST",$JOB,PSAORD))
if PSAORD=""!(PSAOUT)
QUIT
Begin DoDot:1
+7 SET PSAODIFF=$PIECE(^TMP("PSACOST",$JOB,PSAORD),"^",2)
+8 IF $Y+5>IOSL
DO HDR
if PSAOUT
QUIT
+9 WRITE !,"ORDER#: "_PSAORD
+10 SET PSAINV=""
FOR
SET PSAINV=$ORDER(^TMP("PSACOST",$JOB,PSAORD,PSAINV))
if PSAINV=""!(PSAOUT)
QUIT
Begin DoDot:2
+11 SET PSAINVDT=$PIECE(^TMP("PSACOST",$JOB,PSAORD,PSAINV),"^")
SET PSAICOST=$PIECE(^(PSAINV),"^",2)
SET PSAACOST=$PIECE(^(PSAINV),"^",3)
SET PSADIFF=$PIECE(^(PSAINV),"^",4)
+12 IF $Y+4>IOSL
DO HDR
if PSAOUT
QUIT
+13 WRITE !,PSAINV,?27,PSAINVDT,?39,$JUSTIFY(PSAICOST,9,2),?55,$JUSTIFY(PSAACOST,9,2),?71,$JUSTIFY(PSADIFF,7,2)
End DoDot:2
+14 IF $Y+4>IOSL
DO HDR
if PSAOUT
QUIT
+15 SET PSAOCOST=$PIECE(^TMP("PSACOST",$JOB,PSAORD),"^")
SET PSAOACST=$PIECE(^(PSAORD),"^",2)
SET PSAODIFF=$PIECE(^(PSAORD),"^",3)
+16 IF PSAICOST'=PSAOCOST!(PSAACOST'=PSAOACST)
WRITE !,"ORDER TOTAL"
WRITE ?39,$JUSTIFY(PSAOCOST,9,2),?55,$JUSTIFY(PSAOACST,9,2),?69
WRITE $JUSTIFY(PSAODIFF,9,2),!
+17 IF '$TEST
WRITE !
End DoDot:1
+18 IF $EXTRACT(IOST,1,2)="C-"
if PSAOUT
QUIT
DO END^PSAPROC
+19 IF '$TEST
WRITE @IOF
+20 ;
EXIT DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL IO("Q"),^TMP("PSACOST",$JOB)
+1 KILL %,%DT,%ZIS,PSAACOST,PSAAECST,PSABEG,PSABEGX,PSADATA,PSADATE,PSADIFF,PSADJ,PSADJP,PSADJQ,PSAEND,PSAENDX,PSAICOST,PSAIECST,PSAIEN
+2 KILL 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
+3 QUIT
+4 ;
LINE ;Get line item data
+1 SET PSALCOST=$PIECE(PSADATA,"^",3)*$PIECE(PSADATA,"^",5)
SET PSAIECST=PSAIECST+PSALCOST
PRICE SET PSADJP=0
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
+1 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSAPRICE=$SELECT($PIECE(PSANODE,"^",6)'="":$PIECE(PSANODE,"^",6),1:+$PIECE(PSANODE,"^",2))
SET PSADJP=PSAPRICE
+2 IF '$GET(PSADJ)
SET PSAPRICE=$PIECE(PSADATA,"^",5)
QTY SET PSADJQ=0
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
+1 IF $GET(PSADJ)
Begin DoDot:1
+2 SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
+3 SET PSADJQ=$SELECT($PIECE(PSANODE,"^",6)'="":+$PIECE(PSANODE,"^",6),1:+$PIECE(PSANODE,"^",2))
+4 SET PSAACOST=PSADJQ*PSAPRICE
SET PSAAECST=PSAAECST+PSAACOST
End DoDot:1
+5 IF '$GET(PSADJQ)
SET PSAACOST=$PIECE(PSADATA,"^",3)*PSAPRICE
SET PSAAECST=PSAAECST+PSAACOST
+6 QUIT
+7 ;
HDR ;Report header
+1 IF $EXTRACT(IOST,1,2)="C-"
if 'PSAPG
WRITE @IOF
if +PSAPG
DO END^PSAPROC
if PSAOUT
QUIT
+2 IF $EXTRACT(IOST)'="C"
IF +PSAPG
WRITE @IOF
+3 SET PSAPG=PSAPG+1
+4 WRITE !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE "_PSAPG
+5 WRITE !?27,"INVOICE COST SUMMARY REPORT"
+6 IF $EXTRACT(IOST)'="C"
WRITE !,"RUN: "_PSARUN,?27,PSABEGX_" - "_PSAENDX
+7 IF '$TEST
WRITE !,?27,PSABEGX_" - "_PSAENDX
+8 WRITE !!?28,"INVOICE",?41,"INVOICE",?56,"ADJUSTED"
+9 WRITE !,"INVOICE#",?31,"DATE",?44,"COST",?60,"COST",?68,"DIFFERENCE",!,PSASLN
+10 QUIT
