source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPUVEN.m@ 1046

Last change on this file since 1046 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.6 KB
Line 
1PRCPUVEN ;WISC/RFJ-add,update,delete procurement sources ;06 Oct 91
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7ADDVEN(INVPT,ITEMDA,VENDOR,UNITREC,PKGMULT,CONVFACT) ; add procurement source
8 ; vendor=vendorda;prc(440,
9 ; vendor will be added if its not already there.
10 ; data will be updated if not null.
11 I '$D(^PRCP(445,INVPT,1,ITEMDA,0)) Q
12 N %,DATA,X,Y
13 S Y=$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0))
14 I 'Y D
15 . N DA,DIC,D0,DD,DLAYGO,DINUM,X
16 . S:'$D(^PRCP(445,INVPT,1,ITEMDA,5,0)) ^(0)="^445.07IV^^"
17 . S DIC="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",X=VENDOR,DA(1)=ITEMDA,DA(2)=INVPT,DIC(0)="L",DLAYGO=445
18 . D FILE^DICN
19 I '$D(^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)) Q
20 L +^PRCP(445,INVPT,1,ITEMDA,5,+Y)
21 S DATA=^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)
22 I UNITREC S $P(DATA,"^",2)=UNITREC
23 I PKGMULT S $P(DATA,"^",3)=PKGMULT
24 I CONVFACT S $P(DATA,"^",4)=CONVFACT
25 S ^PRCP(445,INVPT,1,ITEMDA,5,+Y,0)=DATA
26 L -^PRCP(445,INVPT,1,ITEMDA,5,+Y)
27 Q
28 ;
29 ;
30DELVEN(INVPT,ITEMDA,VENDORDA) ; delete procurement sources
31 ; vendorda=entryda for procurement source
32 I '$D(^PRCP(445,INVPT,1,ITEMDA,5,VENDORDA,0)) Q
33 N %,DA,DIC,DIK,X,Y
34 S DIK="^PRCP(445,"_INVPT_",1,"_ITEMDA_",5,",DA=VENDORDA,DA(1)=ITEMDA,DA(2)=INVPT
35 D ^DIK
36 Q
37 ;
38 ;
39GETVEN(INVPT,ITEMDA,VENDOR,CONVFACT) ; get procurement source data
40 ; vendor=vendor;prcp(445 or vendor;prc(440
41 ; if 'conv factor, convfact=convfact passed
42 ; returns procsource^unitrec^pkgmult^conv^entryda
43 S %=+$O(^PRCP(445,INVPT,1,ITEMDA,5,"B",VENDOR,0)),Y=$G(^PRCP(445,INVPT,1,ITEMDA,5,%,0))
44 I CONVFACT S:'$P(Y,"^",4) $P(Y,"^",4)=CONVFACT
45 I 'Y Q Y
46 S $P(Y,"^",5)=%
47 Q Y
Note: See TracBrowser for help on using the repository browser.