PSAUP6 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
;This routine looks in the DRUG file for a supply line item. It looks
;for a NDC with an "S" in front of the UPC. It then looks for a matching
;VSN. If it is found, the NDC becomes "S"_UPC.
;
UPC ;If there is no NDC, the VSN is not found, & there is a UPC, look
;for a supply item.
S (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0,PSASUP="S"_$P($P(PSADATA,"^",26),"~")
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
.Q:'$D(^PSDRUG(PSAIEN50,1,PSASYN,0))
.;DAVE B (PSA*3*3)
.Q:$D(^PSDRUG(PSAIEN50,"I"))
.I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN S PSAFND=PSAFND+1,PSAFND1=PSAIEN50_"^"_PSASYN Q
.I $P(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN S PSACNT=PSACNT+1,PSACNT1=PSAIEN50_"^"_PSASYN
;
;If VSN & UPC match, set ^XTMP
I PSAFND=1 D Q
.S PSAIEN=$P(PSAFND1,"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSAFND1,"^",2),$P(^(PSALINE),"^",7)=PSASUB
.S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN,PSANDC=PSASUP,$P(^(PSALINE),"^",4)=PSANDC
;
;If >1 with same VSN & UPC, set # with same UPC & VSN in ^XTMP & flag
I PSAFND>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~"_PSAFND,PSAOK=0 Q
;
;If 1 UPC and ...
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
.;VSN is null, accept as found & set ^XTMP
.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
.;Different VSN, set VSN in UPC piece in ^XTMP
.S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~~"_$P(^PSDRUG(PSAIEN,1,PSASUB,0),"^",5),PSAOK=0
;
;If >1 VSN with differnt NDC, set flag in NDC piece of ^XTMP
I PSACNT>1 S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~"_PSACNT,PSAOK=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAUP6 2230 printed Sep 23, 2025@19:26:54 Page 2
PSAUP6 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
+2 ;This routine looks in the DRUG file for a supply line item. It looks
+3 ;for a NDC with an "S" in front of the UPC. It then looks for a matching
+4 ;VSN. If it is found, the NDC becomes "S"_UPC.
+5 ;
UPC ;If there is no NDC, the VSN is not found, & there is a UPC, look
+1 ;for a supply item.
+2 SET (PSACNT,PSACNT1,PSAFND,PSAFND1,PSAIEN50)=0
SET PSASUP="S"_$PIECE($PIECE(PSADATA,"^",26),"~")
+3 FOR
SET PSAIEN50=+$ORDER(^PSDRUG("C",PSASUP,PSAIEN50))
if 'PSAIEN50
QUIT
SET PSASYN=0
FOR
SET PSASYN=+$ORDER(^PSDRUG("C",PSASUP,PSAIEN50,PSASYN))
if 'PSASYN
QUIT
Begin DoDot:1
+4 if '$DATA(^PSDRUG(PSAIEN50,1,PSASYN,0))
QUIT
+5 ;DAVE B (PSA*3*3)
+6 if $DATA(^PSDRUG(PSAIEN50,"I"))
QUIT
+7 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)=PSAVSN
SET PSAFND=PSAFND+1
SET PSAFND1=PSAIEN50_"^"_PSASYN
QUIT
+8 IF $PIECE(^PSDRUG(PSAIEN50,1,PSASYN,0),"^",4)'=PSAVSN
SET PSACNT=PSACNT+1
SET PSACNT1=PSAIEN50_"^"_PSASYN
End DoDot:1
+9 ;
+10 ;If VSN & UPC match, set ^XTMP
+11 IF PSAFND=1
Begin DoDot:1
+12 SET PSAIEN=$PIECE(PSAFND1,"^")
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
SET PSASUB=$PIECE(PSAFND1,"^",2)
SET $PIECE(^(PSALINE),"^",7)=PSASUB
+13 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
SET PSANDC=PSASUP
SET $PIECE(^(PSALINE),"^",4)=PSANDC
End DoDot:1
QUIT
+14 ;
+15 ;If >1 with same VSN & UPC, set # with same UPC & VSN in ^XTMP & flag
+16 IF PSAFND>1
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~"_PSAFND
SET PSAOK=0
QUIT
+17 ;
+18 ;If 1 UPC and ...
+19 IF PSACNT=1
SET PSAIEN=$PIECE(PSACNT1,"^")
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN
SET PSASUB=$PIECE(PSACNT1,"^",2)
SET $PIECE(^(PSALINE),"^",7)=PSASUB
Begin DoDot:1
+20 ;VSN is null, accept as found & set ^XTMP
+21 IF $PIECE(^PSDRUG(PSAIEN,1,PSASUB,0),"^",4)=""
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
SET PSANDC=PSASUP
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
QUIT
+22 ;Different VSN, set VSN in UPC piece in ^XTMP
+23 SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~~"_$PIECE(^PSDRUG(PSAIEN,1,PSASUB,0),"^",5)
SET PSAOK=0
End DoDot:1
QUIT
+24 ;
+25 ;If >1 VSN with differnt NDC, set flag in NDC piece of ^XTMP
+26 IF PSACNT>1
SET $PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)=$PIECE(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",26)_"~"_PSACNT
SET PSAOK=0
+27 QUIT
