Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPUVEN

PRCPUVEN.m

Go to the documentation of this file.
  1. PRCPUVEN ;WISC/RFJ-add,update,delete procurement sources ;06 Oct 91
  1. ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. ADDVEN(INVPT,ITEMDA,VENDOR,UNITREC,PKGMULT,CONVFACT) ; add procurement source
  1. ; vendor=vendorda;prc(440,
  1. ; vendor will be added if its not already there.
  1. ; data will be updated if not null.
  1. I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
  1. N %,DATA,X,Y
  1. S Y=$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0))
  1. I 'Y D
  1. . N DA,DIC,D0,DD,DLAYGO,DINUM,X
  1. . S:'$D(^PRCP(445,INVPT,1,ITEMDA,5,0)) ^(0)="^445.07IV^^"
  1. . S DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",X=VENDOR,DA(1)=ITEMDA,DA(2)=INVPT,DIC(0)="L",DLAYGO=445
  1. . D FILE^DICN
  1. I '$D(^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)) Q
  1. L +^PRCP(445,INVPT,1,ITEMDA,5,+Y)
  1. S DATA=^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)
  1. I UNITREC S $P(DATA,"^",2)=UNITREC
  1. I PKGMULT S $P(DATA,"^",3)=PKGMULT
  1. I CONVFACT S $P(DATA,"^",4)=CONVFACT
  1. S ^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)=DATA
  1. L -^PRCP(445,INVPT,1,ITEMDA,5,+Y)
  1. Q
  1. ;
  1. ;
  1. DELVEN(INVPT,ITEMDA,VENDORDA) ; delete procurement sources
  1. ; vendorda=entryda for procurement source
  1. I '$D(^PRCP(445,INVPT,1,ITEMDA,5,VENDORDA,0)) Q
  1. N %,DA,DIC,DIK,X,Y
  1. S DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",DA=VENDORDA,DA(1)=ITEMDA,DA(2)=INVPT
  1. D ^DIK
  1. Q
  1. ;
  1. ;
  1. GETVEN(INVPT,ITEMDA,VENDOR,CONVFACT) ; get procurement source data
  1. ; vendor=vendor;prcp(445 or vendor;prc(440
  1. ; if 'conv factor, convfact=convfact passed
  1. ; returns procsource^unitrec^pkgmult^conv^entryda
  1. S %=+$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0)),Y=$G(^PRCP(445,INVPT,1,ITEMDA,5,%,0))
  1. I CONVFACT S:'$P(Y,"^",4) $P(Y,"^",4)=CONVFACT
  1. I 'Y Q Y
  1. S $P(Y,"^",5)=%
  1. Q Y