source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU3.m@ 1360

Last change on this file since 1360 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1PSABRKU3 ;BIR/JMB/PDW-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41,47,67**; 10/24/97;Build 15
3 ;Checking the X12 invoice data.
4 S (PSASTCNT,PSAITCNT,PSACTRL(1))=0
5 K ^TMP($J,"PSAPV SET"),PSAERR
6 S PSALAST=""
7 S PSALINE=0 F S PSALINE=$O(^TMP($J,"PSAPVS",PSALINE)) Q:PSALINE="" S PSADATA=^(PSALINE) D
8 .;check segment order
9 .D ^PSABRKU5 S PSALAST=$P(PSADATA,"^")
10ISA .;control header
11 .I PSALAST="ISA" D Q
12 ..S PSASTCNT=0
13 ..S PSAISA=PSADATA,PSACTRL="" I $L($P(PSADATA,"^",14))'=9 S PSASEG="ISA" D MSG^PSABRKU8
14 .;
15IEA .;control trailer
16 .I PSALAST="IEA" D Q
17 ..I $P(PSADATA,"^",3)'=$P(PSAISA,"^",14) S PSASEG="IEA" D MSG^PSABRKU8
18 .;
19GS .;group header
20 .I PSALAST="GS" S PSAGS=PSADATA D Q
21 ..F %=3,4 S PSAPC=$S(%=3:7,1:9) I $P(PSADATA,"^",%)'=$TR($P(PSAISA,"^",PSAPC)," ") S PSASEG="GS" D MSG^PSABRKU8
22 .;
23GE .;group trailer
24 .I PSALAST="GE" D Q
25 ..I $P(PSADATA,"^",3)'=$P($G(PSAGS),"^",7) S PSASEG="GE" D MSG^PSABRKU8
26 .;
27ST .;set header
28 .I PSALAST="ST" D Q
29 ..S PSAST=PSADATA,PSACTRL=$P(PSADATA,"^",3),PSASTCNT=1,PSAITCNT=0,PSANTYPE=""
30 ..I $L(PSACTRL)<4!($L(PSACTRL)>10) S PSASEG="ST" D MSG^PSABRKU8 Q
31 .. I PSACTRL="0001" S PSACTRL=0 D RESETST
32 ..;PSA*3*41 - McKesson probability of multiple files, may have to
33 ..;increment transaction set control numbers in 'ST' & 'SE'
34 ..I $D(^TMP($J,"PSAPV SET",PSACTRL,"IN")) D RESETST
35 ..I $D(^XTMP("PSAPV",PSACTRL)) D RESETST ;may already be on file
36 .;
37SE .;set trailer
38 .I PSALAST="SE" S PSASTCNT=PSASTCNT+1 D Q
39 ..I $G(PSACTRL(1))'>0,$P(PSADATA,"^",3)'=PSACTRL S PSASEG="SE1" D MSG^PSABRKU8 Q
40 ..I PSASTCNT'=$P(PSADATA,"^",2) S PSASEG="SE2" D MSG^PSABRKU8
41 .;
42BIG .;beginning segment for invoice
43 .I PSALAST="BIG" S PSASTCNT=PSASTCNT+1 D Q
44 ..I $P(PSADATA,"^",4)="" S $P(PSADATA,"^",4)=$P(PSADATA,"^",2)
45 ..S $P(PSADATA,"^",5)=$TR($P(PSADATA,"^",5)," ")
46 ..S ^TMP($J,"PSAPV SET",PSACTRL,"IN")=$P(PSADATA,"^",2,5)
47 .;
48REF .;(not used)
49 .I PSALAST="REF" S PSASTCNT=PSASTCNT+1 Q
50 .;
51 .;buyer, seller, shipping addresses
52N1 .I PSALAST="N1" S PSASTCNT=PSASTCNT+1,PSANTYPE=$P(PSADATA,"^",2) D Q
53 ..I PSANTYPE'="BY",PSANTYPE'="DS",PSANTYPE'="ST" S PSASEG="N1" D MSG^PSABRKU8 Q
54 ..S ^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE)=$P(PSADATA,"^",3)
55 .;
56N2 .I PSALAST="N2" D Q
57 ..D:PSANTYPE="" NTYPE
58 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",2)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
59 .;
60N3 .I PSALAST="N3" D Q
61 ..D:PSANTYPE="" NTYPE
62 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",3)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
63 .;
64N4 .I PSALAST="N4" D Q
65 ..D:PSANTYPE="" NTYPE
66 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",4,6)=$P(PSADATA,"^",2,4) S PSASTCNT=PSASTCNT+1,PSANTYPE=""
67 .;
68DTM .;date time reference
69 .I PSALAST="DTM" S PSASTCNT=PSASTCNT+1 D Q
70 ..S %=$S($P(PSADATA,"^",2)="002":5,$P(PSADATA,"^",2)="035":6,1:0) I '% Q
71 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",%)=$P(PSADATA,"^",3)
72 .;
73IT1 .;invoice line item
74 .I PSALAST="IT1" S PSASTCNT=PSASTCNT+1,PSAITCNT=PSAITCNT+1 D ITEM Q
75 .;BGN PSA*3*67
76PID .;generic vendor item name
77 .I PSALAST="PID" S PSASTCNT=PSASTCNT+1,$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",29)=$S($P(PSADATA,"^",6)=$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28):"Unknown",1:$P(PSADATA,"^",6)) Q
78PO4 .;DESCRIPTION OF ITEM
79 .I PSALAST="PO4" S PSASTCNT=PSASTCNT+1,$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",30)=$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",9) D Q
80 .;END PSA*3*67
81CTT .;item count
82 .I PSALAST="CTT" S PSASTCNT=PSASTCNT+1 D Q
83 ..I PSAITCNT'=$P(PSADATA,"^",2) S PSASEG="CTT" D MSG^PSABRKU8
84 .;
85UNKNOWN .;Segment we don't use
86 .S PSASTCNT=PSASTCNT+1
87 ;
88ERROR S PSASEG=$O(PSAERR("")) D:PSASEG'="" ERROR^PSABRKU8
89 Q
90 ;
91NTYPE S PSASEG="NONTYPE" D NONTYPE^PSABRKU8
92 Q
93 ;
94ITEM ;check line item
95 I '$P(PSADATA,"^",2) S PSASEG="IT1-1" D MSG^PSABRKU8 Q
96 I $P(PSADATA,"^",6)'="DS" S PSASEG="IT1-2" D MSG^PSABRKU8 Q
97 I $P(PSADATA,"^",8)="",$P(PSADATA,"^",10)="",$P(PSADATA,"^",12)="" S PSASEG="IT1-3" D MSG^PSABRKU8 Q
98 ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN
99 S PSAITEM=+$P(PSADATA,"^",2),^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM)=+$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",4)_"^"_$P(PSADATA,"^",5)_"^"_$P(PSADATA,"^",8)_"^"_$P(PSADATA,"^",10)
100 I $P(PSADATA,"^",12)'="",$P(PSADATA,"^",11)="UP" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",26)=$P(PSADATA,"^",12)
101 ;Next line to add vendor Generic Description
102 I $P(PSADATA,"^",14)'="" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28)=$P(PSADATA,"^",14)
103 ;Eop67
104 Q
105RESETST ;Reset PSACTRL
106 S PSACTRL(1)=+PSACTRL+1,X1=PSACTRL(1)
107 S PSACTRL=X1 I $D(^TMP($J,"PSAPV SET",PSACTRL)) G RESETST
108 I $D(^XTMP("PSAPV",PSACTRL)) G RESETST
109 Q
Note: See TracBrowser for help on using the repository browser.