PSAUP6.m

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

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