1 | PSAUP4 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;9/19/97
|
---|
2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,20,21,67**; 10/24/97;Build 15
|
---|
3 | ;This routine prints invoices from the ^XTMP global on the screen or
|
---|
4 | ;to a printer.
|
---|
5 | ;
|
---|
6 | ;References to ^PSDRUG( are covered by IA #2095
|
---|
7 | ;References to ^DIC(51.5( are covered by IA #1931
|
---|
8 | ;
|
---|
9 | W !!,"Enter the device which will be used to print",!,"the invoices with all items, errors, and adjustments.",!
|
---|
10 | S %ZIS="Q" D ^%ZIS I POP S PSAOUT=1 Q
|
---|
11 | I $D(IO("Q")) S ZTDESC="Drug Acct. - Prime Vendor Invoice Upload Report",ZTRTN="DQ^PSAUP4" D ^%ZTLOAD Q
|
---|
12 | ;
|
---|
13 | DQ ;queue starts here
|
---|
14 | S IOM=80
|
---|
15 | 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
|
---|
16 | U IO
|
---|
17 | S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT) D START
|
---|
18 | W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
|
---|
19 | ;
|
---|
20 | EXIT ;Kills printing variables only
|
---|
21 | K %,%ZIS,DIR,DIRUT,PSAAECST,PSABY,PSACS,PSACTRL,PSADATA,PSADATE,PSADEC,PSADRG,PSADJDRG,PSADJORD,PSADJQTY,PSADJSUP,PSADLN,PSADS,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST
|
---|
22 | 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
|
---|
23 | Q
|
---|
24 | ;
|
---|
25 | START S PSAPAGE=1,PSAEND=0 D HEADER S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN"))
|
---|
26 | S (PSADJDRG,PSADJSUP,PSAIECST,PSAAECST)=0,PSAPHARM=$P(PSAIN,"^",7),PSAMV=$P(PSAIN,"^",12)
|
---|
27 | W !,"PRIME VENDOR : ",$S($P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^")'="":$P($G(^("DS")),"^"),1:"UNKNOWN")
|
---|
28 | W !!,"ORDER# : "_$P(PSAIN,"^",4),?40,"ORDER DATE : "_$$DATE($P(PSAIN,"^",3))
|
---|
29 | W !,"INVOICE#: "_$P(PSAIN,"^",2),?40,"INVOICE DATE: "_$$DATE(+PSAIN)
|
---|
30 | S PSASTA=$P(PSAIN,"^",8)
|
---|
31 | 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:"")
|
---|
32 | I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER
|
---|
33 | I $E(IOST,1,2)="C-" D LINE Q
|
---|
34 | W !!,"DELIVERY DATE REQUESTED: ",$$DATE($P(PSAIN,"^",5))
|
---|
35 | W !,"DATE RECEIVED : "_$S(+$P(PSAIN,"^",11)&($$DATE(+$P(PSAIN,"^",11))):" ("_$$DATE($P(PSAIN,"^",6))_")",1:$$DATE($P(PSAIN,"^",6)))
|
---|
36 | I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:$G(PSAOUT) D HEADER
|
---|
37 | ;
|
---|
38 | BUYSHIP W !!,"BUYER INFORMATION:",?40,"SHIPPING INFORMATION:"
|
---|
39 | S PSABY=$G(^XTMP("PSAPV",PSACTRL,"BY"))
|
---|
40 | S PSAST=$G(^XTMP("PSAPV",PSACTRL,"ST"))
|
---|
41 | W !?2,$P(PSABY,"^"),?42,$P(PSAST,"^")
|
---|
42 | I $P(PSABY,"^",2)'=""!($P(PSAST,"^",2)'="") W ! W:$P(PSABY,"^",2)'="" ?2,$P(PSABY,"^",2) W:$P(PSAST,"^",2)'="" ?42,$P(PSAST,"^",2)
|
---|
43 | I $P(PSABY,"^",3)'=""!($P(PSAST,"^",3)'="") W ! W:$P(PSABY,"^",3)'="" ?2,$P(PSABY,"^",3) W:$P(PSAST,"^",3)'="" ?42,$P(PSAST,"^",3)
|
---|
44 | W !?2,$P(PSABY,"^",4)_" "_$P(PSABY,"^",5)_" ",$P(PSABY,"^",6)
|
---|
45 | W ?42,$P(PSAST,"^",4)_" "_$P(PSAST,"^",5)_" ",$P(PSAST,"^",6)
|
---|
46 | I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER
|
---|
47 | ;
|
---|
48 | DISTRIB W !!,"DISTRIBUTOR INFORMATION:"
|
---|
49 | S PSADS=$G(^XTMP("PSAPV",PSACTRL,"DS"))
|
---|
50 | W !?2,$P(PSADS,"^")
|
---|
51 | W:$P(PSADS,"^",2)'="" !?2,$P(PSADS,"^",2)
|
---|
52 | W:$P(PSADS,"^",3)'="" !?2,$P(PSADS,"^",3)
|
---|
53 | W !?2,$P(PSADS,"^",4)_" "_$P(PSADS,"^",5)_" ",$P(PSADS,"^",6)
|
---|
54 | I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER
|
---|
55 | D LINE
|
---|
56 | Q
|
---|
57 | ;
|
---|
58 | DATE(PSADATE) ;convert date
|
---|
59 | S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3)
|
---|
60 | I $TR(%,"/")="" S %="UNKNOWN"
|
---|
61 | Q %
|
---|
62 | ;
|
---|
63 | LINE ;print line items
|
---|
64 | D LINEHDR
|
---|
65 | 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
|
---|
66 | .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
|
---|
67 | .K PSADJQTY,PSAQDUZ,PSAQDT,PSAQREA,PSADJORD,PSAODUZ,PSAODT,PSAOREA
|
---|
68 | .W !,PSALINE
|
---|
69 | DRUG .;Drug
|
---|
70 | .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
|
---|
71 | .I PSADRG,$D(^PSDRUG(PSADRG,"I")) W !,?5,"** INACTIVE IN DRUG FILE **"
|
---|
72 | .I '+$P(PSADATA,"^",15) D
|
---|
73 | ..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
|
---|
74 | ..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
|
---|
75 | ..W ?9,"DRUG UNKNOWN"
|
---|
76 | .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"
|
---|
77 | .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"
|
---|
78 | .;UPC
|
---|
79 | .I $P($P(PSADATA,"^",26),"~")'="" W !?9,"UPC: "_$P($P(PSADATA,"^",26),"~")
|
---|
80 | .;NDC
|
---|
81 | .S PSANDC=$P($P(PSADATA,"^",4),"~")
|
---|
82 | .I $E(PSANDC)'="S" D
|
---|
83 | ..W !?9 D PSANDC1^PSAHELP S PSANDC=PSANDCX
|
---|
84 | ..I PSANDC'="" W PSANDC Q
|
---|
85 | ..W "NDC UNKNOWN"
|
---|
86 | .;
|
---|
87 | .;VSN
|
---|
88 | .W ?25,$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN")
|
---|
89 | .;
|
---|
90 | .;QTY
|
---|
91 | .;No Adjusted Qty
|
---|
92 | .S PSAIECST=PSAIECST+($P(PSADATA,"^")*$P(PSADATA,"^",3))
|
---|
93 | .I $P(PSADATA,"^",8)="" W ?40,$J($P(PSADATA,"^"),6) S PSAECOST=$P(PSADATA,"^")*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST
|
---|
94 | .;Adj. Qty (P)
|
---|
95 | .I $P(PSADATA,"^",8)'="" D
|
---|
96 | ..S PSADJQTY=$P(PSADATA,"^",8),PSAQDUZ=$P(PSADATA,"^",9),PSAQDT=$P(PSADATA,"^",10),PSAQREA=$P(PSADATA,"^",11)
|
---|
97 | ..S PSAECOST=PSADJQTY*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST
|
---|
98 | ..W ?40,$J($P(PSADATA,"^",8),6)_"("_$P(PSADATA,"^")_")"
|
---|
99 | .;
|
---|
100 | OU .;Order Unit
|
---|
101 | .I '+$P(PSADATA,"^",12) D
|
---|
102 | ..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
|
---|
103 | ..I $P($G(PSADATA),"^",2)'="",$P($G(PSADATA),"^",2)'["~",'$D(^DIC(51.5,"B",$P(PSADATA,"^",2))) W ?48," ?-> "_$P(PSADATA,"^",2)
|
---|
104 | ..I $P($P(PSADATA,"^",2),"~")="" D ^PSAHELP
|
---|
105 | .;Adj. OU (P)
|
---|
106 | .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),"~")_")"
|
---|
107 | .;Unit price
|
---|
108 | .S PSADEC=$S($L($P($P(PSADATA,"^",3),".",2))>1:$L($P($P(PSADATA,"^",3),".",2)),1:2)
|
---|
109 | .W ?59,$J($P(PSADATA,"^",3),7,PSADEC)
|
---|
110 | .;Extended cost
|
---|
111 | .W ?67,$J(PSAECOST,12,2)
|
---|
112 | .I $Y+9>IOSL,+$P(PSADATA,"^",21),+$P(PSADATA,"^",27) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
|
---|
113 | .I $G(PSADRG) D HAVEDRG
|
---|
114 | .I '$G(PSADRG) W !?9,"STOCK LEVEL : ",!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21),!?9,"DISPENSE UNITS/ORDER UNIT: " D DISP^PSAP67
|
---|
115 | .;
|
---|
116 | .;Print Adj Qty
|
---|
117 | .I $G(PSADJQTY)'="" D
|
---|
118 | ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
|
---|
119 | ..W !!?9,"ADJUSTED QUANTITY: "_PSADJQTY,!?9,$$DATE(PSAQDT)_" "_$P($G(^VA(200,+PSAQDUZ,0)),"^"),!?11,PSAQREA
|
---|
120 | .;Print Adj OU
|
---|
121 | .I +$G(PSADJORD) D
|
---|
122 | ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER,LINEHDR
|
---|
123 | ..W !!,?9,"ADJUSTED ORDER UNIT: "_$P($G(^DIC(51.5,+PSADJORD,0)),"^")
|
---|
124 | ..W !?9,$$DATE(PSAODT)_" "_$P($G(^VA(200,+PSAODUZ,0)),"^")_" - "_$P($G(^DIC(51.5,PSADJORD,0)),"^")
|
---|
125 | .W !
|
---|
126 | Q:PSAOUT
|
---|
127 | I $Y+6>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER
|
---|
128 | W !,PSASLN
|
---|
129 | W:$G(PSAAECST)'=$G(PSAIECST) !?48,"TOTAL ADUSTED COST",?67,$J(PSAAECST,12,2),!
|
---|
130 | W !?48,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2)
|
---|
131 | S PSAEND=1
|
---|
132 | I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT D HEADER
|
---|
133 | I PSADJDRG,$E(IOST)'="C" W !!,"* THE DRUG WAS MATCHED TO THE DRUG FILE."
|
---|
134 | I PSADJSUP,$E(IOST)'="C" W !!,"* THE ITEM IS A SUPPLY ITEM."
|
---|
135 | D:$E(IOST,1,2)="C-" SCREEN
|
---|
136 | Q
|
---|
137 | ;
|
---|
138 | LINEHDR ;item header
|
---|
139 | W !?50,"ORDER",?62,"COST/",?71,"EXTENDED"
|
---|
140 | W !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,!
|
---|
141 | Q
|
---|
142 | ;
|
---|
143 | HEADER ;Page header
|
---|
144 | I PSAFPG&($E(IOST,1,2)="C-") W @IOF G HDR1
|
---|
145 | S PSAFPG=0
|
---|
146 | W:'PSAFPG @IOF
|
---|
147 | HDR1 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"
|
---|
148 | W !?26,"PRIME VENDOR UPLOAD REPORT",!
|
---|
149 | W:PSAPAGE'=1 !,"ORDER#: "_$P(PSAIN,"^",4)_" INVOICE#: "_$P(PSAIN,"^",2)
|
---|
150 | I $E(IOST,1,2)="C-" W ?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
|
---|
151 | I $E(IOST)'="C" W !,"RUN: "_PSARUN,?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
|
---|
152 | S PSAPAGE=PSAPAGE+1
|
---|
153 | Q
|
---|
154 | SCREEN ;Hold on screen
|
---|
155 | S PSAS=20-$Y I PSAS F PSASS=1:1:PSAS W !
|
---|
156 | I PSADJDRG,PSAEND W !," * THE DRUG WAS MATCHED TO THE DRUG FILE."
|
---|
157 | I PSADJSUP,PSAEND W !,"** THE ITEM IS A SUPPLY ITEM."
|
---|
158 | S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
|
---|
159 | Q
|
---|
160 | ;
|
---|
161 | HAVEDRG ;Display data if drug is found.
|
---|
162 | ;DAVE B (PSA*3*20) 7SEP99 ADDED $G TO NEXT LINE
|
---|
163 | S PSACS=$S($P($G(^PSDRUG(PSADRG,2)),"^",3)["N":1,1:0)
|
---|
164 | I PSACS D
|
---|
165 | .I PSAMV,+$P($G(^PSD(58.8,PSAMV,0)),"^",14) D Q
|
---|
166 | ..W !?9,"STOCK LEVEL : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",3))
|
---|
167 | ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",5))
|
---|
168 | .I 'PSAMV W !?9,"STOCK LEVEL : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)
|
---|
169 | I 'PSACS D
|
---|
170 | .I PSAPHARM,+$P($G(^PSD(58.8,PSAPHARM,0)),"^",14) D
|
---|
171 | ..W !?9,"STOCK LEVEL : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",3))
|
---|
172 | ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",5))
|
---|
173 | .I 'PSAPHARM W !?9,"STOCK LEVEL : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)
|
---|
174 | W !?9,"DISPENSE UNITS/ORDER UNIT: "
|
---|
175 | 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:"")
|
---|
176 | D DISP^PSAP67
|
---|
177 | Q
|
---|