source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUP5.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 8.3 KB
Line 
1PSAUP5 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;10/9/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,37,48**; 10/24/97
3 ;References to ^DIC(51.5 are covered by IA #1931
4 ;References to ^PSDRUG( are covered by IA #2095
5 ;This routine looks in the DRUG file for each line item on the order.
6 ;It looks for the NDC then VSN. If it is not found, no data is stored.
7 ;
8 S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL="" D
9 .I '$D(^XTMP("PSAPV",PSACTRL,"IN"))!($P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",8)="P") Q
10 .S PSAIN=^XTMP("PSAPV",PSACTRL,"IN"),PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2),PSACS=0
11 .W !,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(+PSAIN)
12 .;PSA*3*31 check/fix possible string too long errors
13 .S PSAUPLD=1,PSALINE=0 D PSAP31^PSAVSN K PSAUPLD
14 .S PSALINE=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
15 ..Q:'$D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P"
16 ..S PSAOK=1,PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE),PSANDC=$P(PSADATA,"^",4),PSAVSN=$P(PSADATA,"^",5)
17 ..DO GETDRUG W "."
18 ..S:PSAOK $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="OK"
19 ..D:PSAOK OUAUTO^PSAUP8 ;*48 ORDER UNIT AUTO ADJUST
20 .S (PSACNT,PSALLCS,PSALLOK,PSASUP)=0
21 .S:PSACS $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",9)="CS"
22 .S PSALINE=0 F S PSALINE=+$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE D
23 ..S PSACNT=PSACNT+1
24 ..S:$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS" PSALLCS=PSALLCS+1
25 ..S:$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="OK" PSALLOK=PSALLOK+1
26 ..S:'+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) PSASUP=PSASUP+1
27 .I PSACNT=PSASUP S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",13)="SUP"
28 .I PSACNT=PSALLCS S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",10)="ALL CS"
29 .I PSACNT=PSALLOK S $P(^XTMP("PSAPV",PSACTRL,"IN"),"^",8)="OK"
30 Q
31 ;
32GETDRUG ;Looks for NDC then VSNs in DRUG file.
33 ;PSA*3*21 (DAVE B 3MAR2000)
34 ;Make NDC vendor proof
35 I $G(PSANDC)'="",$L(PSANDC)>12 S PSANDC=$E(PSANDC,1,12)
36 I $G(PSANDC)'="",$L(PSANDC)<12 D
37 .I $G(PSANDC)'="",'$D(^PSDRUG("NDC",PSANDC)) S X=12,X1=$L(PSANDC) F X=1:1:(12-X1) S PSANDC="0"_PSANDC
38 .S NDC0=1 F X=1:1:$L(PSANDC) I $E(PSANDC,X)'=0&($E(PSANDC,X)'="-") K NDC0
39 .I $G(NDC0)=1 S PSANDC=""
40 ;Dave B (PSA*3*2)
41 I $D(PSANDC) S PSANDC=$P(PSANDC,"~")
42 I $D(PSAVSN) S PSAVSN=$P(PSAVSN,"~")
43 G:PSANDC=0 GETVSN
44 I PSANDC'="" S PSAIEN=+$O(^PSDRUG("C",PSANDC,0)) I PSAIEN S PSASUB=+$O(^PSDRUG("C",PSANDC,PSAIEN,0)) G FOUND
45 ;
46GETVSN ;Looks for Vendor Stock Number then NDC.
47 I PSAVSN'="" S PSAIEN=+$O(^PSDRUG("AVSN",PSAVSN,0)) I PSAIEN S PSASUB=+$O(^PSDRUG("AVSN",PSAVSN,PSAIEN,0)) G FOUND
48 ;
49 I (PSANDC=""&PSAVSN=""),$P(PSADATA,"^",26)'="" D ^PSAUP6
50 ;
51 S:'+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) PSAOK=0
52 G UOM
53 ;
54FOUND ;Store line item data if ordered item was found in DRUG file.
55 I $P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" S PSACS=1,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS"
56 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,$P(^(PSALINE),"^",7)=PSASUB
57 ;
58NDC ;If >1 NDC in DRUG file, store how many.
59 ;^XTMP $P4=NDC ~ # of nodes with same VSN (if >1 NDC) ~ VSN if different
60 ; than one on SYNONYM multiple (if 1 NDC)
61 I PSANDC'="",$O(^PSDRUG("C",PSANDC,0)) D
62 .S (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0
63 .;
64 .;DAVE B (PSA*3*2)
65 .F S PSAIEN50=+$O(^PSDRUG("C",PSANDC,PSAIEN50)) Q:'PSAIEN50 I '$D(^PSDRUG(PSAIEN50,"I")) S PSASYN=0 F S PSASYN=+$O(^PSDRUG("C",PSANDC,PSAIEN50,PSASYN)) Q:'PSASYN D
66 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
67 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSAFND1=PSAIEN50_"^"_PSASYN Q
68 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSACNT1=PSAIEN50_"^"_PSASYN
69 .;
70 .;If NDC & VSN match, set ^XTMP
71 .I PSAFND=1 S PSAIEN=$P(PSAFND1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSAFND1,"^",2),$P(^(PSALINE),"^",7)=PSASUB,$P(^(PSALINE),"^",4)=PSANDC Q
72 .;
73 .;If >1 with same NDC & VSN, set # with same NDC & VSN in ^XTMP & flag
74 .I PSAFND>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~"_PSAFND,PSAOK=0 Q
75 .;
76 .;If 1 NDC and ...
77 .I PSACNT=1 S PSAIEN=$P(PSACNT1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSACNT1,"^",2),$P(^(PSALINE),"^",7)=PSASUB D Q
78 ..;VSN is null, accept as found & set ^XTMP
79 ..I $P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4)="" S PSAIEN=$P(PSACNT1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSACNT1,"^",2),$P(^(PSALINE),"^",7)=PSASUB,$P(^(PSALINE),"^",4)=PSANDC Q
80 ..;Different VSN, set VSN in NDC piece in ^XTMP
81 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~~"_$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4),PSAOK=0
82 .;
83 .;If >1 NDC with differnt VSN, set flag in NDC piece of ^XTMP
84 .I PSACNT>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)_"~"_PSACNT,PSAOK=0
85 ;
86VSN ;If there >1 VSN with same VSN, store how many.
87 ;^XTMP $P5=VSN ~ # of nodes with same UOM (if >1 VSN) ~ NDC if different
88 ; than one on SYNONYM multiple (if 1 VSN)
89 I PSAVSN'="",$O(^PSDRUG("AVSN",PSAVSN,0)) D
90 .S (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0
91 .;
92 .;DAVE B (PSA*3*2)
93 .F S PSAIEN50=+$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50)) Q:'PSAIEN50 I '$D(^PSDRUG(PSAIEN50,"I")) S PSASYN=0 F S PSASYN=+$O(^PSDRUG("AVSN",PSAVSN,PSAIEN50,PSASYN)) Q:'PSASYN D
94 ..Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
95 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")=PSANDC S PSAFND=PSAFND+1,PSAFND1=PSAIEN50_"^"_PSASYN Q
96 ..I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^")'=PSANDC S PSACNT=PSACNT+1,PSACNT1=PSAIEN50_"^"_PSASYN
97 .;
98 .;If VSN & NDC match, set ^XTMP
99 .I PSAFND=1 D Q
100 ..I '+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) D
101 ...S PSAIEN=$P(PSAFND1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSAFND1,"^",2),$P(^(PSALINE),"^",7)=PSASUB
102 ...S:$P($G(^PSDRUG(PSAIEN,2)),"^",3)["N" $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="CS",PSACS=1
103 ...S:$P($G(^PSDRUG(PSAIEN,2)),"^",3)'["N" $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",19)="",PSACS=0
104 ..;DAVE B (PSA*3*21) Ensure VSN = one number
105 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=+$G(PSAVSN)
106 .;
107 .;If >1 with same VSN & NDC, set # with same NDC & VSN in ^XTMP & flag
108 .I PSAFND>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~"_PSAFND,PSAOK=0 Q
109 .;
110 .;If 1 VSN and ...
111 .I PSACNT=1 D Q
112 ..I '+$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6) S PSAIEN=$P(PSACNT1,"^"),$P(^(PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSACNT1,"^",2),$P(^(PSALINE),"^",7)=PSASUB
113 ..;NDC is null, accept as found & set ^XTMP
114 ..I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)="" S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^") Q
115 ..;Different VSN, set VSN in NDC piece in ^XTMP
116 ..;PSA*3*31 - Check to ensure VSN not already stored
117 ..;result is string too long error
118 ..I $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)'[$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^") S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~~"_$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^"),PSAOK=0
119 .;
120 .;If >1 VSN with different NDC, set flag in NDC piece of ^XTMP
121 .I PSACNT>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)_"~"_PSACNT,PSAOK=0
122 ;
123UOM ;Locates X12 Unit of Measure Code in ORDER UNIT file.
124 ;^XTMP $P2=Alpha OU ~ 51.5 IEN
125 K PSAUOM I $P(PSADATA,"^",2)="" S PSAOK=0 G QTY
126 ;
127 ;If order unit is standard order unit, set IEN in ^XTMP
128 S PSAUOM=$O(^DIC(51.5,"B",$P($P(PSADATA,"^",2),"~"),0))
129 I 'PSAUOM D Q:'PSAOK
130 .I +$P(PSADATA,"^",6),+$P(PSADATA,"^",7),+$P($G(^PSDRUG(PSAIEN,1,+$P(PSADATA,"^",7),0)),"^",5) D
131 ..S PSAUOM=+$P($G(^PSDRUG(PSAIEN,1,+$P(PSADATA,"^",7),0)),"^",5),PSAUOMN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2),"~")
132 ..S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOMN_"~"_PSAUOM K PSAUOMN
133 .S:'PSAUOM PSAOK=0
134 I PSAUOM S PSAUOMN=$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2),"~"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",2)=PSAUOMN_"~"_PSAUOM K PSAUOMN
135 ;
136QTY ;If qty is 0 or blank, set flag
137 I '+$P(PSADATA,"^") S PSAOK=0
138 ;
139DUOU ;If no dispense units per order unit, set flag.
140 S PSADRG=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6),PSASYN=$P(^(PSALINE),"^",7)
141 S:'PSASYN PSAOK=0
142 I PSASYN,'$P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",7) S PSAOK=0
143 Q
Note: See TracBrowser for help on using the repository browser.