| 1 | PSAUP6 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
 | 
|---|
| 2 |  ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
 | 
|---|
| 3 |  ;This routine looks in the DRUG file for a supply line item. It looks
 | 
|---|
| 4 |  ;for a NDC with an "S" in front of the UPC. It then looks for a matching
 | 
|---|
| 5 |  ;VSN. If it is found, the NDC becomes "S"_UPC.
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | UPC ;If there is no NDC, the VSN is not found, & there is a UPC, look
 | 
|---|
| 8 |  ;for a supply item.
 | 
|---|
| 9 |  S (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0,PSASUP="S"_$P($P(PSADATA,"^",26),"~")
 | 
|---|
| 10 |  F  S PSAIEN50=+$O(^PSDRUG("C",PSASUP,PSAIEN50)) Q:'PSAIEN50  S PSASYN=0 F  S PSASYN=+$O(^PSDRUG("C",PSASUP,PSAIEN50,PSASYN)) Q:'PSASYN  D
 | 
|---|
| 11 |  .Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
 | 
|---|
| 12 |  .;DAVE B (PSA*3*3)
 | 
|---|
| 13 |  .Q:$D(^PSDRUG(PSAIEN50,"I"))
 | 
|---|
| 14 |  .I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSAFND1=PSAIEN50_"^"_PSASYN Q
 | 
|---|
| 15 |  .I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSACNT1=PSAIEN50_"^"_PSASYN
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 |  ;If VSN & UPC match, set ^XTMP
 | 
|---|
| 18 |  I PSAFND=1 D  Q
 | 
|---|
| 19 |  .S PSAIEN=$P(PSAFND1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSAFND1,"^",2),$P(^(PSALINE),"^",7)=PSASUB
 | 
|---|
| 20 |  .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,PSANDC=PSASUP,$P(^(PSALINE),"^",4)=PSANDC
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 |  ;If >1 with same VSN & UPC, set # with same UPC & VSN in ^XTMP & flag
 | 
|---|
| 23 |  I PSAFND>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~"_PSAFND,PSAOK=0 Q
 | 
|---|
| 24 |  ;
 | 
|---|
| 25 |  ;If 1 UPC and ...
 | 
|---|
| 26 |  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
 | 
|---|
| 27 |  .;VSN is null, accept as found & set ^XTMP
 | 
|---|
| 28 |  .I $P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4)="" S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,PSANDC=PSASUP,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC Q
 | 
|---|
| 29 |  .;Different VSN, set VSN in UPC piece in ^XTMP
 | 
|---|
| 30 |  .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~~"_$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",5),PSAOK=0
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 |  ;If >1 VSN with differnt NDC, set flag in NDC piece of ^XTMP
 | 
|---|
| 33 |  I PSACNT>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~"_PSACNT,PSAOK=0
 | 
|---|
| 34 |  Q
 | 
|---|