- 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 Mar 13, 2025@20:55:30 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
