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
;
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 ---[H[J[2J[HPSAUP4 9649 printed Oct 16, 2024@17:51:39 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),!
+30 WRITE !?48,"TOTAL INVOICED COST",?67,$JUSTIFY(PSAIECST,12,2)
+31 SET PSAEND=1
+32 IF $Y+5>IOSL
if $EXTRACT(IOST,1,2)="C-"
DO SCREEN
if PSAOUT
QUIT
DO HEADER
+33 IF PSADJDRG
IF $EXTRACT(IOST)'="C"
WRITE !!,"* THE DRUG WAS MATCHED TO THE DRUG FILE."
+34 IF PSADJSUP
IF $EXTRACT(IOST)'="C"
WRITE !!,"* THE ITEM IS A SUPPLY ITEM."
+35 if $EXTRACT(IOST,1,2)="C-"
DO SCREEN
+36 QUIT
+37 ;
LINEHDR ;item header
+1 WRITE !?50,"ORDER",?62,"COST/",?71,"EXTENDED"
+2 WRITE !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,!
+3 QUIT
+4 ;
+1 IF PSAFPG&($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
GOTO HDR1
+2 SET PSAFPG=0
+3 if 'PSAFPG
WRITE @IOF
HDR1 WRITE !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"
+1 WRITE !?26,"PRIME VENDOR UPLOAD REPORT",!
+2 if PSAPAGE'=1
WRITE !,"ORDER#: "_$PIECE(PSAIN,"^",4)_" INVOICE#: "_$PIECE(PSAIN,"^",2)
+3 IF $EXTRACT(IOST,1,2)="C-"
WRITE ?(74-$LENGTH(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
+4 IF $EXTRACT(IOST)'="C"
WRITE !,"RUN: "_PSARUN,?(74-$LENGTH(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
+5 SET PSAPAGE=PSAPAGE+1
+6 QUIT
SCREEN ;Hold on screen
+1 SET PSAS=20-$Y
IF PSAS
FOR PSASS=1:1:PSAS
WRITE !
+2 IF PSADJDRG
IF PSAEND
WRITE !," * THE DRUG WAS MATCHED TO THE DRUG FILE."
+3 IF PSADJSUP
IF PSAEND
WRITE !,"** THE ITEM IS A SUPPLY ITEM."
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
+5 QUIT
+6 ;
HAVEDRG ;Display data if drug is found.
+1 ;DAVE B (PSA*3*20) 7SEP99 ADDED $G TO NEXT LINE
+2 SET PSACS=$SELECT($PIECE($GET(^PSDRUG(PSADRG,2)),"^",3)["N":1,1:0)
+3 IF PSACS
Begin DoDot:1
+4 IF PSAMV
IF +$PIECE($GET(^PSD(58.8,PSAMV,0)),"^",14)
Begin DoDot:2
+5 WRITE !?9,"STOCK LEVEL : "_$SELECT(+$PIECE(PSADATA,"^",27):+$PIECE(PSADATA,"^",27),1:+$PIECE($GET(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",3))
+6 WRITE !?9,"REORDER LEVEL: "_$SELECT(+$PIECE(PSADATA,"^",21):+$PIECE(PSADATA,"^",21),1:+$PIECE($GET(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",5))
End DoDot:2
QUIT
+7 IF 'PSAMV
WRITE !?9,"STOCK LEVEL : "_$PIECE(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$PIECE(PSADATA,"^",21)
End DoDot:1
+8 IF 'PSACS
Begin DoDot:1
+9 IF PSAPHARM
IF +$PIECE($GET(^PSD(58.8,PSAPHARM,0)),"^",14)
Begin DoDot:2
+10 WRITE !?9,"STOCK LEVEL : "_$SELECT(+$PIECE(PSADATA,"^",27):+$PIECE(PSADATA,"^",27),1:+$PIECE($GET(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",3))
+11 WRITE !?9,"REORDER LEVEL: "_$SELECT(+$PIECE(PSADATA,"^",21):+$PIECE(PSADATA,"^",21),1:+$PIECE($GET(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",5))
End DoDot:2
+12 IF 'PSAPHARM
WRITE !?9,"STOCK LEVEL : "_$PIECE(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$PIECE(PSADATA,"^",21)
End DoDot:1
+13 WRITE !?9,"DISPENSE UNITS/ORDER UNIT: "
+14 WRITE $SELECT(+$PIECE(PSADATA,"^",20):+$PIECE(PSADATA,"^",20),+$PIECE($GET(^PSDRUG(PSADRG,1,+$PIECE(PSADATA,"^",7),0)),"^",7):+$PIECE($GET(^PSDRUG(PSADRG,1,+$PIECE(PSADATA,"^",7),0)),"^",7),1:"")
+15 DO DISP^PSAP67
+16 QUIT
