source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU6.m@ 1397

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

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