source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUTL6.m@ 1169

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1PSAUTL6 ;VMP/PDW-PULL ORDER INVOICE LINE ITEM DATA ;03/28/2005
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**42**; 10/24/97
3 ;References to ^PSDRUG( are covered by IA #2095
4 ;
5ITEM(PSAIEN,PSAIEN1,PSALINE,ITM,FORM) ;RETURN LINE ITEM INFO with data adjusted IN .ITM array by reference
6 ;PSAIEN - Order IEN, PSAIEN1 - Invoice IEN, PSALINE - Item IEN
7 ; FORM="I" INTERNAL VALUE, ="" EXTERNAL VALUE
8 ; ITM return array pass by reference ITM(field number #)= value
9 ; .01-Line, 1-Drug, 2-QTY, 3-OU, 4-PPOU, 5-DtProc, 6-Proc, 7-DtVer
10 ; 8-Ver, 10-DUOU, 11-ReOrd Lev, 12-CS, 13-NDC(-), 14-VSN, 15-UPC
11 ; 16-Syn Node, 17-Stock Lev
12 ; code borrowed from PSAVER6 March 25,2005
13 N PSACOST,PSACS,PSADASH,PSADATA,PSADJ,PSADJD,PSADJO,PSADJP,PSADJQ
14 N PSADRG,PSADT,PSADUOU,PSADUQTY,PSADUREC,PSAIN,PSAINV,PSAINVDT,PSALEN,PSALOC,PSAMSG,PSANDC,PSANODE,PSANPDU,PSANPOU
15 N PSAODASH,PSAONDC,PSAORD,PSAOU,PSAPDU,PSAPOU,PSAQTY,PSAREORD,PSASET,PSASTOCK,PSASUP,PSAT,PSATDRG,PSATEMP,PSAVBKG,PSAVDUZ,PSAVEND,PSAVSN,X
16 N PSA0QTY,PSASUB,IENS
17 I '$L($G(FORM)) S FORM=""
18 S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
19 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
20 S PSAVDUZ=$P(PSADATA,"^",9),PSASUP=0
21 S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
22 I '$G(PSADJ) S PSADRG=$S(+$P(PSADATA,"^",2):+$P(PSADATA,"^",2),1:0) G CS
23 I $G(PSADJ) D
24 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
25 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
26 .I PSADJD'?1.N S PSASUP=1
27 .S PSADRG=$S(PSADJ&('PSASUP):+PSADJD,PSADJ&(PSASUP):$G(PSADJD),1:+$P(PSADATA,"^",2))
28 .I +PSADJD,$G(PSADJD)=+$G(PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" S PSADRG=+PSADJD Q
29 .I +PSADJD,$G(PSADJD)=+$G(PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q
30CS ;Q:PSASUP!('PSADRG)
31 S PSACS=$S(+$P(PSADATA,"^",10):1,1:0)
32 S PSADJQ=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
33 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
34 ;
35 ;PSA*3*1 (DAVE B)
36 S PSAQTY=$S(($G(PSADJQ)'=""&(+PSADJ)):PSADJQ,1:+$P(PSADATA,"^",3))
37 S PSAOU=$S(+$P(PSADATA,"^",4):+$P(PSADATA,"^",4),1:"")
38 ;
39 ;DAVE B (PSA*3*3)
40 ;I +$P($P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)),"^",5),"~",2) S PSAOU=$P($P($G(^(2)),"^",5),"~",2)
41 ;
42 S PSADJO=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
43 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
44 S:$G(PSADJO) PSAOU=$G(PSADJO)
45 S PSANDC=$P(PSADATA,"^",11) I FORM="" D PSANDC1^PSAHELP S PSANDC=PSANDCX K PSANDCX
46 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
47 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
48 S (PSAPOU,PSANPOU)=$S($G(PSADJP):PSADJP,1:+$P(PSADATA,"^",5)),PSALEN=$L($P(PSANPOU,".")),(PSAPOU,PSANPOU)=$J(PSANPOU,PSALEN,2)
49 S PSAVSN=$P(PSADATA,"^",12)
50 S PSALOC=$S(+PSACS:+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5))
51TEMP S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
52 S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4)
53 S PSADUOU=$S(+PSADUOU:+PSADUOU,+PSASUB&(+$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7),1:1)
54 S PSADUREC=$S(PSADUOU:PSAQTY*PSADUOU,1:0)
55 ;
56 ;DAVE B (18NOV98)
57 ;I PSADUREC=0,$D(PSAQTY),$P($G(^PSDRUG(PSADRG,660)),"^",5)'="" S PSADUREC=(PSAQTY*($P(^PSDRUG(PSADRG,660),"^",5)))
58 S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",5):+$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",5),1:0)
59 S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",3):+$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",3),1:0)
60 S ITM(.01)=PSALINE,ITM(1)=PSADRG,ITM(2)=PSAQTY,ITM(3)=PSAOU,ITM(4)=PSANPOU,ITM(13)=PSANDC,ITM(10)=PSADUOU
61 S IENS=PSALINE_","_PSAIEN1_","_PSAIEN
62 F X=5,6,7,8,12,14,15,16,17 S ITM(X)=$$GET1^DIQ(58.81125,IENS,X,FORM)
63 I FORM'="I" S ITM(3)=$$GET1^DIQ(51.5,ITM(3),.01) S:+ITM(1)=ITM(1) ITM(1)=$$GET1^DIQ(50,ITM(1),.01) ;also handle supply items ITM(1)=supply item name
64 Q
Note: See TracBrowser for help on using the repository browser.