PRCPUVEN.m

PRCPUVEN ;WISC/RFJ-add,update,delete procurement sources            ;06 Oct 91

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

ADDVEN(INVPT,ITEMDA,VENDOR,UNITREC,PKGMULT,CONVFACT) ;  add procurement source

 ;  vendor=vendorda;prc(440,

 ;  vendor will be added if its not already there.

 ;  data will be updated if not null.

 I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q

 N %,DATA,X,Y

 S Y=$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0))

 I 'Y D

 .   N DA,DIC,D0,DD,DLAYGO,DINUM,X

 .   S:'$D(^PRCP(445,INVPT,1,ITEMDA,5,0)) ^(0)="^445.07IV^^"

 .   S DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",X=VENDOR,DA(1)=ITEMDA,DA(2)=INVPT,DIC(0)="L",DLAYGO=445

 .   D FILE^DICN

 I '$D(^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)) Q

 L +^PRCP(445,INVPT,1,ITEMDA,5,+Y)

 S DATA=^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)

 I UNITREC S $P(DATA,"^",2)=UNITREC

 I PKGMULT S $P(DATA,"^",3)=PKGMULT

 I CONVFACT S $P(DATA,"^",4)=CONVFACT

 S ^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)=DATA

 L -^PRCP(445,INVPT,1,ITEMDA,5,+Y)

 Q

 ;

 ;

DELVEN(INVPT,ITEMDA,VENDORDA) ;  delete procurement sources

 ;  vendorda=entryda for procurement source

 I '$D(^PRCP(445,INVPT,1,ITEMDA,5,VENDORDA,0)) Q

 N %,DA,DIC,DIK,X,Y

 S DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",DA=VENDORDA,DA(1)=ITEMDA,DA(2)=INVPT

 D ^DIK

 Q

 ;

 ;

GETVEN(INVPT,ITEMDA,VENDOR,CONVFACT) ;  get procurement source data

 ;  vendor=vendor;prcp(445 or vendor;prc(440

 ;  if 'conv factor, convfact=convfact passed

 ;  returns procsource^unitrec^pkgmult^conv^entryda

 S %=+$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0)),Y=$G(^PRCP(445,INVPT,1,ITEMDA,5,%,0))

 I CONVFACT S:'$P(Y,"^",4) $P(Y,"^",4)=CONVFACT

 I 'Y Q Y

 S $P(Y,"^",5)=%

 Q Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPUVEN   1721     printed  Apr 09, 2024@21:07:52                                                                                                                                                                                                    Page 2

PRCPUVEN  ;WISC/RFJ-add,update,delete procurement sources            ;06 Oct 91

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

ADDVEN(INVPT,ITEMDA,VENDOR,UNITREC,PKGMULT,CONVFACT) ;  add procurement source

 +1       ;  vendor=vendorda;prc(440,

 +2       ;  vendor will be added if its not already there.

 +3       ;  data will be updated if not null.

 +4        IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,0))

               QUIT 

 +5        NEW %,DATA,X,Y

 +6        SET Y=$ORDER(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0))

 +7        IF 'Y

               Begin DoDot:1

 +8                NEW DA,DIC,D0,DD,DLAYGO,DINUM,X

 +9                if '$DATA(^PRCP(445,INVPT,1,ITEMDA,5,0))

                       SET ^(0)="^445.07IV^^"

 +10               SET DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,"

                   SET X=VENDOR

                   SET DA(1)=ITEMDA

                   SET DA(2)=INVPT

                   SET DIC(0)="L"

                   SET DLAYGO=445

 +11               DO FILE^DICN

               End DoDot:1

 +12       IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,5,+Y,0))

               QUIT 

 +13       LOCK +^PRCP(445,INVPT,1,ITEMDA,5,+Y)

 +14       SET DATA=^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)

 +15       IF UNITREC

               SET $PIECE(DATA,"^",2)=UNITREC

 +16       IF PKGMULT

               SET $PIECE(DATA,"^",3)=PKGMULT

 +17       IF CONVFACT

               SET $PIECE(DATA,"^",4)=CONVFACT

 +18       SET ^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)=DATA

 +19       LOCK -^PRCP(445,INVPT,1,ITEMDA,5,+Y)

 +20       QUIT 

 +21      ;

 +22      ;

DELVEN(INVPT,ITEMDA,VENDORDA) ;  delete procurement sources

 +1       ;  vendorda=entryda for procurement source

 +2        IF '$DATA(^PRCP(445,INVPT,1,ITEMDA,5,VENDORDA,0))

               QUIT 

 +3        NEW %,DA,DIC,DIK,X,Y

 +4        SET DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,"

           SET DA=VENDORDA

           SET DA(1)=ITEMDA

           SET DA(2)=INVPT

 +5        DO ^DIK

 +6        QUIT 

 +7       ;

 +8       ;

GETVEN(INVPT,ITEMDA,VENDOR,CONVFACT) ;  get procurement source data

 +1       ;  vendor=vendor;prcp(445 or vendor;prc(440

 +2       ;  if 'conv factor, convfact=convfact passed

 +3       ;  returns procsource^unitrec^pkgmult^conv^entryda

 +4        SET %=+$ORDER(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0))

           SET Y=$GET(^PRCP(445,INVPT,1,ITEMDA,5,%,0))

 +5        IF CONVFACT

               if '$PIECE(Y,"^",4)

                   SET $PIECE(Y,"^",4)=CONVFACT

 +6        IF 'Y

               QUIT Y

 +7        SET $PIECE(Y,"^",5)=%

 +8        QUIT Y