Routine: PSACOST

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

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

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

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

PSACOST.m