PSAUP4.m

PSAUP4 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;9/19/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,20,21,67**; 10/24/97;Build 15

 ;This routine prints invoices from the ^XTMP global on the screen or

 ;to a printer.

 ;

 ;References to ^PSDRUG( are covered by IA #2095

 ;References to ^DIC(51.5( are covered by IA #1931

 ;

 W !!,"Enter the device which will be used to print",!,"the invoices with all items, errors, and adjustments.",!

 S %ZIS="Q" D ^%ZIS I POP S PSAOUT=1 Q

 I $D(IO("Q")) S ZTDESC="Drug Acct. - Prime Vendor Invoice Upload Report",ZTRTN="DQ^PSAUP4" D ^%ZTLOAD Q

 ;

DQ ;queue starts here

 S IOM=80

 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSADJSUP,PSAOUT)=0,PSAFPG=1

 U IO

 S PSACTRL=0 F  S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT)  D START

 W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")

 ;

EXIT ;Kills printing variables only

 K %,%ZIS,DIR,DIRUT,PSAAECST,PSABY,PSACS,PSACTRL,PSADATA,PSADATE,PSADEC,PSADRG,PSADJDRG,PSADJORD,PSADJQTY,PSADJSUP,PSADLN,PSADS,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST

 K PSAIN,PSALINE,PSANDC,PSAODT,PSAODUZ,PSAOREA,PSAOUT,PSAPAGE,PSAPHARM,PSAQDT,PSAQDUZ,PSAQREA,PSAMV,PSARUN,PSAS,PSASLN,PSASS,PSAST,PSASTA,PSATOT,Y,ZTDESC,ZTRTN,ZTSK

 Q

 ;

START S PSAPAGE=1,PSAEND=0 D HEADER S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN"))

 S (PSADJDRG,PSADJSUP,PSAIECST,PSAAECST)=0,PSAPHARM=$P(PSAIN,"^",7),PSAMV=$P(PSAIN,"^",12)

 W !,"PRIME VENDOR : ",$S($P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^")'="":$P($G(^("DS")),"^"),1:"UNKNOWN")

 W !!,"ORDER#  : "_$P(PSAIN,"^",4),?40,"ORDER DATE  : "_$$DATE($P(PSAIN,"^",3))

 W !,"INVOICE#: "_$P(PSAIN,"^",2),?40,"INVOICE DATE: "_$$DATE(+PSAIN)

 S PSASTA=$P(PSAIN,"^",8)

 W !,"STATUS  : "_$S(PSASTA="":"UPLOADED WITH ERRORS",PSASTA="OK":"UPLOADED WITHOUT ERRORS",PSASTA="P":"PROCESSED",1:"UNKNOWN")_$S($P(PSAIN,"^",13)="SUP":" (SUPPLY INVOICE)",1:"")

 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER

 I $E(IOST,1,2)="C-" D LINE Q

 W !!,"DELIVERY DATE REQUESTED: ",$$DATE($P(PSAIN,"^",5))

 W !,"DATE RECEIVED          : "_$S(+$P(PSAIN,"^",11)&($$DATE(+$P(PSAIN,"^",11))):" ("_$$DATE($P(PSAIN,"^",6))_")",1:$$DATE($P(PSAIN,"^",6)))

 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:$G(PSAOUT)  D HEADER

 ;

BUYSHIP W !!,"BUYER INFORMATION:",?40,"SHIPPING INFORMATION:"

 S PSABY=$G(^XTMP("PSAPV",PSACTRL,"BY"))

 S PSAST=$G(^XTMP("PSAPV",PSACTRL,"ST"))

 W !?2,$P(PSABY,"^"),?42,$P(PSAST,"^")

 I $P(PSABY,"^",2)'=""!($P(PSAST,"^",2)'="") W ! W:$P(PSABY,"^",2)'="" ?2,$P(PSABY,"^",2) W:$P(PSAST,"^",2)'="" ?42,$P(PSAST,"^",2)

 I $P(PSABY,"^",3)'=""!($P(PSAST,"^",3)'="") W ! W:$P(PSABY,"^",3)'="" ?2,$P(PSABY,"^",3) W:$P(PSAST,"^",3)'="" ?42,$P(PSAST,"^",3)

 W !?2,$P(PSABY,"^",4)_" "_$P(PSABY,"^",5)_"  ",$P(PSABY,"^",6)

 W ?42,$P(PSAST,"^",4)_" "_$P(PSAST,"^",5)_"  ",$P(PSAST,"^",6)

 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER

 ;

DISTRIB W !!,"DISTRIBUTOR INFORMATION:"

 S PSADS=$G(^XTMP("PSAPV",PSACTRL,"DS"))

 W !?2,$P(PSADS,"^")

 W:$P(PSADS,"^",2)'="" !?2,$P(PSADS,"^",2)

 W:$P(PSADS,"^",3)'="" !?2,$P(PSADS,"^",3)

 W !?2,$P(PSADS,"^",4)_" "_$P(PSADS,"^",5)_"  ",$P(PSADS,"^",6)

 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER

 D LINE

 Q

 ;

DATE(PSADATE)         ;convert date

 S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3)

 I $TR(%,"/")="" S %="UNKNOWN"

 Q %

 ;

LINE ;print line items

 D LINEHDR

 S (PSAICOST,PSALINE,PSATOT)=0 F  S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE!(PSAOUT)  S PSADATA=^(PSALINE),PSADRG=0 D  Q:PSAOUT

 .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR

 .K PSADJQTY,PSAQDUZ,PSAQDT,PSAQREA,PSADJORD,PSAODUZ,PSAODT,PSAOREA

 .W !,PSALINE

DRUG .;Drug

 .I +$P(PSADATA,"^",15) S PSADRG=+$P(PSADATA,"^",15) W ?8,"*"_$P($G(^PSDRUG(+$P(PSADATA,"^",15),0)),"^")_$S(+$P(PSADATA,"^",6)&($P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'=""):" ("_$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^")_")",1:"") S PSADJDRG=1

 .I PSADRG,$D(^PSDRUG(PSADRG,"I")) W !,?5,"** INACTIVE IN DRUG FILE **"

 .I '+$P(PSADATA,"^",15) D

 ..I +$P(PSADATA,"^",6),$P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'="" W ?9,$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^") S PSADRG=+$P(PSADATA,"^",6) Q

 ..I $P($G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")),"^",3)'="" W ?7,"**"_$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3)  S PSADJSUP=1,PSADRG=0 Q

 ..W ?9,"DRUG UNKNOWN"

 .I $P(PSADATA,"^",19)="CS" W " (CONTROLLED SUBS)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT  W !?5,"*** INACTIVE IN MASTER VAULT"

 .E  I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION"

 .;UPC

 .I $P($P(PSADATA,"^",26),"~")'="" W !?9,"UPC: "_$P($P(PSADATA,"^",26),"~")

 .;NDC

 .S PSANDC=$P($P(PSADATA,"^",4),"~")

 .I $E(PSANDC)'="S" D

 ..W !?9 D PSANDC1^PSAHELP S PSANDC=PSANDCX

 ..I PSANDC'="" W PSANDC Q

 ..W "NDC UNKNOWN"

 .;

 .;VSN

 .W ?25,$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN")

 .;

 .;QTY

 .;No Adjusted Qty

 .S PSAIECST=PSAIECST+($P(PSADATA,"^")*$P(PSADATA,"^",3))

 .I $P(PSADATA,"^",8)="" W ?40,$J($P(PSADATA,"^"),6) S PSAECOST=$P(PSADATA,"^")*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST

 .;Adj. Qty (P)

 .I $P(PSADATA,"^",8)'="" D

 ..S PSADJQTY=$P(PSADATA,"^",8),PSAQDUZ=$P(PSADATA,"^",9),PSAQDT=$P(PSADATA,"^",10),PSAQREA=$P(PSADATA,"^",11)

 ..S PSAECOST=PSADJQTY*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST

 ..W ?40,$J($P(PSADATA,"^",8),6)_"("_$P(PSADATA,"^")_")"

 .;

OU .;Order Unit

 .I '+$P(PSADATA,"^",12) D

 ..I +$P($P(PSADATA,"^",2),"~",2),$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^")'="" W ?53,$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^") Q

 ..I $P($G(PSADATA),"^",2)'="",$P($G(PSADATA),"^",2)'["~",'$D(^DIC(51.5,"B",$P(PSADATA,"^",2))) W ?48," ?-> "_$P(PSADATA,"^",2)

 ..I $P($P(PSADATA,"^",2),"~")="" D ^PSAHELP

 .;Adj. OU (P)

 .I +$P(PSADATA,"^",12) S PSADJORD=$P(PSADATA,"^",12),PSAODUZ=$P(PSADATA,"^",13),PSAODT=$P(PSADATA,"^",14) W ?53,$P($G(^DIC(51.5,+$P(PSADATA,"^",12),0)),"^")_"("_$P($P(PSADATA,"^",2),"~")_")"

 .;Unit price

 .S PSADEC=$S($L($P($P(PSADATA,"^",3),".",2))>1:$L($P($P(PSADATA,"^",3),".",2)),1:2)

 .W ?59,$J($P(PSADATA,"^",3),7,PSADEC)

 .;Extended cost

 .W ?67,$J(PSAECOST,12,2)

 .I $Y+9>IOSL,+$P(PSADATA,"^",21),+$P(PSADATA,"^",27) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR

 .I $G(PSADRG) D HAVEDRG

 .I '$G(PSADRG) W !?9,"STOCK LEVEL  : ",!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21),!?9,"DISPENSE UNITS/ORDER UNIT: " D DISP^PSAP67

 .;

 .;Print Adj Qty

 .I $G(PSADJQTY)'="" D

 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR

 ..W !!?9,"ADJUSTED QUANTITY: "_PSADJQTY,!?9,$$DATE(PSAQDT)_" "_$P($G(^VA(200,+PSAQDUZ,0)),"^"),!?11,PSAQREA

 .;Print Adj OU

 .I +$G(PSADJORD) D

 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR

 ..W !!,?9,"ADJUSTED ORDER UNIT: "_$P($G(^DIC(51.5,+PSADJORD,0)),"^")

 ..W !?9,$$DATE(PSAODT)_" "_$P($G(^VA(200,+PSAODUZ,0)),"^")_" - "_$P($G(^DIC(51.5,PSADJORD,0)),"^")

 .W !

 Q:PSAOUT

 I $Y+6>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER

 W !,PSASLN

 W:$G(PSAAECST)'=$G(PSAIECST) !?48,"TOTAL ADUSTED COST",?67,$J(PSAAECST,12,2),!

 W !?48,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2)

 S PSAEND=1

 I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER

 I PSADJDRG,$E(IOST)'="C" W !!,"* THE DRUG WAS MATCHED TO THE DRUG FILE."

 I PSADJSUP,$E(IOST)'="C" W !!,"* THE ITEM IS A SUPPLY ITEM."

 D:$E(IOST,1,2)="C-" SCREEN

 Q

 ;

LINEHDR ;item header

 W !?50,"ORDER",?62,"COST/",?71,"EXTENDED"

 W !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,!

 Q

 ;

HEADER ;Page header

 I PSAFPG&($E(IOST,1,2)="C-") W @IOF G HDR1

 S PSAFPG=0

 W:'PSAFPG @IOF

HDR1 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"

 W !?26,"PRIME VENDOR UPLOAD REPORT",!

 W:PSAPAGE'=1 !,"ORDER#: "_$P(PSAIN,"^",4)_"  INVOICE#: "_$P(PSAIN,"^",2)

 I $E(IOST,1,2)="C-" W ?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN

 I $E(IOST)'="C" W !,"RUN: "_PSARUN,?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN

 S PSAPAGE=PSAPAGE+1

 Q

SCREEN ;Hold on screen

 S PSAS=20-$Y I PSAS F PSASS=1:1:PSAS W !

 I PSADJDRG,PSAEND W !," * THE DRUG WAS MATCHED TO THE DRUG FILE."

 I PSADJSUP,PSAEND W !,"** THE ITEM IS A SUPPLY ITEM."

 S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1

 Q

 ;

HAVEDRG ;Display data if drug is found.

 ;DAVE B (PSA*3*20) 7SEP99 ADDED $G TO NEXT LINE

 S PSACS=$S($P($G(^PSDRUG(PSADRG,2)),"^",3)["N":1,1:0)

 I PSACS D

 .I PSAMV,+$P($G(^PSD(58.8,PSAMV,0)),"^",14) D  Q

 ..W !?9,"STOCK LEVEL  : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",3))

 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",5))

 .I 'PSAMV W !?9,"STOCK LEVEL  : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)

 I 'PSACS D

 .I PSAPHARM,+$P($G(^PSD(58.8,PSAPHARM,0)),"^",14) D

 ..W !?9,"STOCK LEVEL  : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",3))

 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",5))

 .I 'PSAPHARM W !?9,"STOCK LEVEL  : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)

 W !?9,"DISPENSE UNITS/ORDER UNIT: "

 W $S(+$P(PSADATA,"^",20):+$P(PSADATA,"^",20),+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7):+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7),1:"")

 D DISP^PSAP67

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSAUP4   9649     printed  Feb 18, 2025@23:17:11                                                                                                                                                                                                      Page 2

PSAUP4    ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;9/19/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,20,21,67**; 10/24/97;Build 15

 +2       ;This routine prints invoices from the ^XTMP global on the screen or

 +3       ;to a printer.

 +4       ;

 +5       ;References to ^PSDRUG( are covered by IA #2095

 +6       ;References to ^DIC(51.5( are covered by IA #1931

 +7       ;

 +8        WRITE !!,"Enter the device which will be used to print",!,"the invoices with all items, errors, and adjustments.",!

 +9        SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               SET PSAOUT=1

               QUIT 

 +10       IF $DATA(IO("Q"))

               SET ZTDESC="Drug Acct. - Prime Vendor Invoice Upload Report"

               SET ZTRTN="DQ^PSAUP4"

               DO ^%ZTLOAD

               QUIT 

 +11      ;

DQ        ;queue starts here

 +1        SET IOM=80

 +2        DO NOW^%DTC

           SET Y=%

           DO DD^%DT

           SET PSARUN=$EXTRACT(Y,1,18)

           SET $PIECE(PSASLN,"-",80)=""

           SET $PIECE(PSADLN,"=",80)=""

           SET (PSADJDRG,PSADJSUP,PSAOUT)=0

           SET PSAFPG=1

 +3        USE IO

 +4        SET PSACTRL=0

           FOR 

               SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))

               if PSACTRL=""!(PSAOUT)

                   QUIT 

               DO START

 +5        WRITE @IOF

           DO ^%ZISC

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           KILL IO("Q")

 +6       ;

EXIT      ;Kills printing variables only

 +1        KILL %,%ZIS,DIR,DIRUT,PSAAECST,PSABY,PSACS,PSACTRL,PSADATA,PSADATE,PSADEC,PSADRG,PSADJDRG,PSADJORD,PSADJQTY,PSADJSUP,PSADLN,PSADS,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST

 +2        KILL PSAIN,PSALINE,PSANDC,PSAODT,PSAODUZ,PSAOREA,PSAOUT,PSAPAGE,PSAPHARM,PSAQDT,PSAQDUZ,PSAQREA,PSAMV,PSARUN,PSAS,PSASLN,PSASS,PSAST,PSASTA,PSATOT,Y,ZTDESC,ZTRTN,ZTSK

 +3        QUIT 

 +4       ;

START      SET PSAPAGE=1

           SET PSAEND=0

           DO HEADER

           SET PSAIN=$GET(^XTMP("PSAPV",PSACTRL,"IN"))

 +1        SET (PSADJDRG,PSADJSUP,PSAIECST,PSAAECST)=0

           SET PSAPHARM=$PIECE(PSAIN,"^",7)

           SET PSAMV=$PIECE(PSAIN,"^",12)

 +2        WRITE !,"PRIME VENDOR : ",$SELECT($PIECE($GET(^XTMP("PSAPV",PSACTRL,"DS")),"^")'="":$PIECE($GET(^("DS")),"^"),1:"UNKNOWN")

 +3        WRITE !!,"ORDER#  : "_$PIECE(PSAIN,"^",4),?40,"ORDER DATE  : "_$$DATE($PIECE(PSAIN,"^",3))

 +4        WRITE !,"INVOICE#: "_$PIECE(PSAIN,"^",2),?40,"INVOICE DATE: "_$$DATE(+PSAIN)

 +5        SET PSASTA=$PIECE(PSAIN,"^",8)

 +6        WRITE !,"STATUS  : "_$SELECT(PSASTA="":"UPLOADED WITH ERRORS",PSASTA="OK":"UPLOADED WITHOUT ERRORS",PSASTA="P":"PROCESSED",1:"UNKNOWN")_$SELECT($PIECE(PSAIN,"^",13)="SUP":" (SUPPLY INVOICE)",1:"")

 +7        IF $Y+8>IOSL

               if $EXTRACT(IOST,1,2)="C-"

                   DO SCREEN

               if PSAOUT

                   QUIT 

               DO HEADER

 +8        IF $EXTRACT(IOST,1,2)="C-"

               DO LINE

               QUIT 

 +9        WRITE !!,"DELIVERY DATE REQUESTED: ",$$DATE($PIECE(PSAIN,"^",5))

 +10       WRITE !,"DATE RECEIVED          : "_$SELECT(+$PIECE(PSAIN,"^",11)&($$DATE(+$PIECE(PSAIN,"^",11))):" ("_$$DATE($PIECE(PSAIN,"^",6))_")",1:$$DATE($PIECE(PSAIN,"^",6)))

 +11       IF $Y+8>IOSL

               if $EXTRACT(IOST,1,2)="C-"

                   DO SCREEN

               if $GET(PSAOUT)

                   QUIT 

               DO HEADER

 +12      ;

BUYSHIP    WRITE !!,"BUYER INFORMATION:",?40,"SHIPPING INFORMATION:"

 +1        SET PSABY=$GET(^XTMP("PSAPV",PSACTRL,"BY"))

 +2        SET PSAST=$GET(^XTMP("PSAPV",PSACTRL,"ST"))

 +3        WRITE !?2,$PIECE(PSABY,"^"),?42,$PIECE(PSAST,"^")

 +4        IF $PIECE(PSABY,"^",2)'=""!($PIECE(PSAST,"^",2)'="")

               WRITE !

               if $PIECE(PSABY,"^",2)'=""

                   WRITE ?2,$PIECE(PSABY,"^",2)

               if $PIECE(PSAST,"^",2)'=""

                   WRITE ?42,$PIECE(PSAST,"^",2)

 +5        IF $PIECE(PSABY,"^",3)'=""!($PIECE(PSAST,"^",3)'="")

               WRITE !

               if $PIECE(PSABY,"^",3)'=""

                   WRITE ?2,$PIECE(PSABY,"^",3)

               if $PIECE(PSAST,"^",3)'=""

                   WRITE ?42,$PIECE(PSAST,"^",3)

 +6        WRITE !?2,$PIECE(PSABY,"^",4)_" "_$PIECE(PSABY,"^",5)_"  ",$PIECE(PSABY,"^",6)

 +7        WRITE ?42,$PIECE(PSAST,"^",4)_" "_$PIECE(PSAST,"^",5)_"  ",$PIECE(PSAST,"^",6)

 +8        IF $Y+8>IOSL

               if $EXTRACT(IOST,1,2)="C-"

                   DO SCREEN

               if PSAOUT

                   QUIT 

               DO HEADER

 +9       ;

DISTRIB    WRITE !!,"DISTRIBUTOR INFORMATION:"

 +1        SET PSADS=$GET(^XTMP("PSAPV",PSACTRL,"DS"))

 +2        WRITE !?2,$PIECE(PSADS,"^")

 +3        if $PIECE(PSADS,"^",2)'=""

               WRITE !?2,$PIECE(PSADS,"^",2)

 +4        if $PIECE(PSADS,"^",3)'=""

               WRITE !?2,$PIECE(PSADS,"^",3)

 +5        WRITE !?2,$PIECE(PSADS,"^",4)_" "_$PIECE(PSADS,"^",5)_"  ",$PIECE(PSADS,"^",6)

 +6        IF $Y+8>IOSL

               if $EXTRACT(IOST,1,2)="C-"

                   DO SCREEN

               if PSAOUT

                   QUIT 

               DO HEADER

 +7        DO LINE

 +8        QUIT 

 +9       ;

DATE(PSADATE) ;convert date

 +1        SET %=$EXTRACT(PSADATE,4,5)_"/"_$EXTRACT(PSADATE,6,7)_"/"_$EXTRACT(PSADATE,2,3)

 +2        IF $TRANSLATE(%,"/")=""

               SET %="UNKNOWN"

 +3        QUIT %

 +4       ;

LINE      ;print line items

 +1        DO LINEHDR

 +2        SET (PSAICOST,PSALINE,PSATOT)=0

           FOR 

               SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))

               if 'PSALINE!(PSAOUT)

                   QUIT 

               SET PSADATA=^(PSALINE)

               SET PSADRG=0

               Begin DoDot:1

 +3                IF $Y+5>IOSL

                       if $EXTRACT(IOST,1,2)="C-"

                           DO SCREEN

                       if PSAOUT

                           QUIT 

                       DO HEADER

                       DO LINEHDR

 +4                KILL PSADJQTY,PSAQDUZ,PSAQDT,PSAQREA,PSADJORD,PSAODUZ,PSAODT,PSAOREA

 +5                WRITE !,PSALINE

DRUG      ;Drug

 +1                IF +$PIECE(PSADATA,"^",15)

                       SET PSADRG=+$PIECE(PSADATA,"^",15)

                       WRITE ?8,"*"_$PIECE($GET(^PSDRUG(+$PIECE(PSADATA,"^",15),0)),"^")_$SELECT(+$PIECE(PSADATA,"^",6)&($PIECE($GET(^PSDRUG(+$PIECE(PSADATA,"^",6),0)),"^")'=""):" ("_$PIECE(^PSDRUG(+$PIECE(PSADATA,"^",6),0),"^")_")",1:"")

                       SET PSADJDRG=1

 +2                IF PSADRG

                       IF $DATA(^PSDRUG(PSADRG,"I"))

                           WRITE !,?5,"** INACTIVE IN DRUG FILE **"

 +3                IF '+$PIECE(PSADATA,"^",15)

                       Begin DoDot:2

 +4                        IF +$PIECE(PSADATA,"^",6)

                               IF $PIECE($GET(^PSDRUG(+$PIECE(PSADATA,"^",6),0)),"^")'=""

                                   WRITE ?9,$PIECE(^PSDRUG(+$PIECE(PSADATA,"^",6),0),"^")

                                   SET PSADRG=+$PIECE(PSADATA,"^",6)

                                   QUIT 

 +5                        IF $PIECE($GET(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")),"^",3)'=""

                               WRITE ?7,"**"_$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3)

                               SET PSADJSUP=1

                               SET PSADRG=0

                               QUIT 

 +6                        WRITE ?9,"DRUG UNKNOWN"

                       End DoDot:2

 +7                IF $PIECE(PSADATA,"^",19)="CS"

                       WRITE " (CONTROLLED SUBS)"

                       IF $PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",12),1,PSADRG,0)),"^",14)

                           IF $PIECE($GET(^(0)),"^",14)'>DT

                               WRITE !?5,"*** INACTIVE IN MASTER VAULT"

 +8               IF '$TEST

                       IF PSADRG

                           IF $PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",7),1,PSADRG,0)),"^",14)

                               IF $PIECE($GET(^(0)),"^",14)'>DT

                                   WRITE !?5,"*** INACTIVE IN PHARMACY LOCATION"

 +9       ;UPC

 +10               IF $PIECE($PIECE(PSADATA,"^",26),"~")'=""

                       WRITE !?9,"UPC: "_$PIECE($PIECE(PSADATA,"^",26),"~")

 +11      ;NDC

 +12               SET PSANDC=$PIECE($PIECE(PSADATA,"^",4),"~")

 +13               IF $EXTRACT(PSANDC)'="S"

                       Begin DoDot:2

 +14                       WRITE !?9

                           DO PSANDC1^PSAHELP

                           SET PSANDC=PSANDCX

 +15                       IF PSANDC'=""

                               WRITE PSANDC

                               QUIT 

 +16                       WRITE "NDC UNKNOWN"

                       End DoDot:2

 +17      ;

 +18      ;VSN

 +19               WRITE ?25,$SELECT($PIECE($PIECE(PSADATA,"^",5),"~")'="":$EXTRACT($PIECE($PIECE(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN")

 +20      ;

 +21      ;QTY

 +22      ;No Adjusted Qty

 +23               SET PSAIECST=PSAIECST+($PIECE(PSADATA,"^")*$PIECE(PSADATA,"^",3))

 +24               IF $PIECE(PSADATA,"^",8)=""

                       WRITE ?40,$JUSTIFY($PIECE(PSADATA,"^"),6)

                       SET PSAECOST=$PIECE(PSADATA,"^")*$PIECE(PSADATA,"^",3)

                       SET PSAAECST=PSAAECST+PSAECOST

 +25      ;Adj. Qty (P)

 +26               IF $PIECE(PSADATA,"^",8)'=""

                       Begin DoDot:2

 +27                       SET PSADJQTY=$PIECE(PSADATA,"^",8)

                           SET PSAQDUZ=$PIECE(PSADATA,"^",9)

                           SET PSAQDT=$PIECE(PSADATA,"^",10)

                           SET PSAQREA=$PIECE(PSADATA,"^",11)

 +28                       SET PSAECOST=PSADJQTY*$PIECE(PSADATA,"^",3)

                           SET PSAAECST=PSAAECST+PSAECOST

 +29                       WRITE ?40,$JUSTIFY($PIECE(PSADATA,"^",8),6)_"("_$PIECE(PSADATA,"^")_")"

                       End DoDot:2

 +30      ;

OU        ;Order Unit

 +1                IF '+$PIECE(PSADATA,"^",12)

                       Begin DoDot:2

 +2                        IF +$PIECE($PIECE(PSADATA,"^",2),"~",2)

                               IF $PIECE($GET(^DIC(51.5,+$PIECE($PIECE(PSADATA,"^",2),"~",2),0)),"^")'=""

                                   WRITE ?53,$PIECE($GET(^DIC(51.5,+$PIECE($PIECE(PSADATA,"^",2),"~",2),0)),"^")

                                   QUIT 

 +3                        IF $PIECE($GET(PSADATA),"^",2)'=""

                               IF $PIECE($GET(PSADATA),"^",2)'["~"

                                   IF '$DATA(^DIC(51.5,"B",$PIECE(PSADATA,"^",2)))

                                       WRITE ?48," ?-> "_$PIECE(PSADATA,"^",2)

 +4                        IF $PIECE($PIECE(PSADATA,"^",2),"~")=""

                               DO ^PSAHELP

                       End DoDot:2

 +5       ;Adj. OU (P)

 +6                IF +$PIECE(PSADATA,"^",12)

                       SET PSADJORD=$PIECE(PSADATA,"^",12)

                       SET PSAODUZ=$PIECE(PSADATA,"^",13)

                       SET PSAODT=$PIECE(PSADATA,"^",14)

                       WRITE ?53,$PIECE($GET(^DIC(51.5,+$PIECE(PSADATA,"^",12),0)),"^")_"("_$PIECE($PIECE(PSADATA,"^",2),"~")_")"

 +7       ;Unit price

 +8                SET PSADEC=$SELECT($LENGTH($PIECE($PIECE(PSADATA,"^",3),".",2))>1:$LENGTH($PIECE($PIECE(PSADATA,"^",3),".",2)),1:2)

 +9                WRITE ?59,$JUSTIFY($PIECE(PSADATA,"^",3),7,PSADEC)

 +10      ;Extended cost

 +11               WRITE ?67,$JUSTIFY(PSAECOST,12,2)

 +12               IF $Y+9>IOSL

                       IF +$PIECE(PSADATA,"^",21)

                           IF +$PIECE(PSADATA,"^",27)

                               if $EXTRACT(IOST,1,2)="C-"

                                   DO SCREEN

                               if PSAOUT

                                   QUIT 

                               DO HEADER

                               DO LINEHDR

 +13               IF $GET(PSADRG)

                       DO HAVEDRG

 +14               IF '$GET(PSADRG)

                       WRITE !?9,"STOCK LEVEL  : ",!?9,"REORDER LEVEL: "_$PIECE(PSADATA,"^",21),!?9,"DISPENSE UNITS/ORDER UNIT: "

                       DO DISP^PSAP67

 +15      ;

 +16      ;Print Adj Qty

 +17               IF $GET(PSADJQTY)'=""

                       Begin DoDot:2

 +18                       IF $Y+5>IOSL

                               if $EXTRACT(IOST,1,2)="C-"

                                   DO SCREEN

                               if PSAOUT

                                   QUIT 

                               DO HEADER

                               DO LINEHDR

 +19                       WRITE !!?9,"ADJUSTED QUANTITY: "_PSADJQTY,!?9,$$DATE(PSAQDT)_" "_$PIECE($GET(^VA(200,+PSAQDUZ,0)),"^"),!?11,PSAQREA

                       End DoDot:2

 +20      ;Print Adj OU

 +21               IF +$GET(PSADJORD)

                       Begin DoDot:2

 +22                       IF $Y+5>IOSL

                               if $EXTRACT(IOST,1,2)="C-"

                                   DO SCREEN

                               if PSAOUT

                                   QUIT 

                               DO HEADER

                               DO LINEHDR

 +23                       WRITE !!,?9,"ADJUSTED ORDER UNIT: "_$PIECE($GET(^DIC(51.5,+PSADJORD,0)),"^")

 +24                       WRITE !?9,$$DATE(PSAODT)_" "_$PIECE($GET(^VA(200,+PSAODUZ,0)),"^")_" - "_$PIECE($GET(^DIC(51.5,PSADJORD,0)),"^")

                       End DoDot:2

 +25               WRITE !

               End DoDot:1

               if PSAOUT

                   QUIT 

 +26       if PSAOUT

               QUIT 

 +27       IF $Y+6>IOSL

               if $EXTRACT(IOST,1,2)="C-"

                   DO SCREEN

               if PSAOUT

                   QUIT 

               DO HEADER

 +28       WRITE !,PSASLN

 +29       if $GET(PSAAECST)'=$GET(PSAIECST)

               WRITE !?48,"TOTAL ADUSTED COST",?67,$JUSTIFY(PSAAECST,12,2),!