65 lines
4.1 KiB
Mathematica
65 lines
4.1 KiB
Mathematica
PSAUTL6 ;VMP/PDW-PULL ORDER INVOICE LINE ITEM DATA ;03/28/2005
|
|
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**42**; 10/24/97
|
|
;References to ^PSDRUG( are covered by IA #2095
|
|
;
|
|
ITEM(PSAIEN,PSAIEN1,PSALINE,ITM,FORM) ;RETURN LINE ITEM INFO with data adjusted IN .ITM array by reference
|
|
;PSAIEN - Order IEN, PSAIEN1 - Invoice IEN, PSALINE - Item IEN
|
|
; FORM="I" INTERNAL VALUE, ="" EXTERNAL VALUE
|
|
; ITM return array pass by reference ITM(field number #)= value
|
|
; .01-Line, 1-Drug, 2-QTY, 3-OU, 4-PPOU, 5-DtProc, 6-Proc, 7-DtVer
|
|
; 8-Ver, 10-DUOU, 11-ReOrd Lev, 12-CS, 13-NDC(-), 14-VSN, 15-UPC
|
|
; 16-Syn Node, 17-Stock Lev
|
|
; code borrowed from PSAVER6 March 25,2005
|
|
N PSACOST,PSACS,PSADASH,PSADATA,PSADJ,PSADJD,PSADJO,PSADJP,PSADJQ
|
|
N PSADRG,PSADT,PSADUOU,PSADUQTY,PSADUREC,PSAIN,PSAINV,PSAINVDT,PSALEN,PSALOC,PSAMSG,PSANDC,PSANODE,PSANPDU,PSANPOU
|
|
N PSAODASH,PSAONDC,PSAORD,PSAOU,PSAPDU,PSAPOU,PSAQTY,PSAREORD,PSASET,PSASTOCK,PSASUP,PSAT,PSATDRG,PSATEMP,PSAVBKG,PSAVDUZ,PSAVEND,PSAVSN,X
|
|
N PSA0QTY,PSASUB,IENS
|
|
I '$L($G(FORM)) S FORM=""
|
|
S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
|
|
S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
|
|
S PSAVDUZ=$P(PSADATA,"^",9),PSASUP=0
|
|
S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
|
|
I '$G(PSADJ) S PSADRG=$S(+$P(PSADATA,"^",2):+$P(PSADATA,"^",2),1:0) G CS
|
|
I $G(PSADJ) D
|
|
.S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
|
|
.S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
|
|
.I PSADJD'?1.N S PSASUP=1
|
|
.S PSADRG=$S(PSADJ&('PSASUP):+PSADJD,PSADJ&(PSASUP):$G(PSADJD),1:+$P(PSADATA,"^",2))
|
|
.I +PSADJD,$G(PSADJD)=+$G(PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" S PSADRG=+PSADJD Q
|
|
.I +PSADJD,$G(PSADJD)=+$G(PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q
|
|
CS ;Q:PSASUP!('PSADRG)
|
|
S PSACS=$S(+$P(PSADATA,"^",10):1,1:0)
|
|
S PSADJQ=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
|
|
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))
|
|
;
|
|
;PSA*3*1 (DAVE B)
|
|
S PSAQTY=$S(($G(PSADJQ)'=""&(+PSADJ)):PSADJQ,1:+$P(PSADATA,"^",3))
|
|
S PSAOU=$S(+$P(PSADATA,"^",4):+$P(PSADATA,"^",4),1:"")
|
|
;
|
|
;DAVE B (PSA*3*3)
|
|
;I +$P($P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)),"^",5),"~",2) S PSAOU=$P($P($G(^(2)),"^",5),"~",2)
|
|
;
|
|
S PSADJO=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
|
|
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))
|
|
S:$G(PSADJO) PSAOU=$G(PSADJO)
|
|
S PSANDC=$P(PSADATA,"^",11) I FORM="" D PSANDC1^PSAHELP S PSANDC=PSANDCX K PSANDCX
|
|
S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
|
|
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))
|
|
S (PSAPOU,PSANPOU)=$S($G(PSADJP):PSADJP,1:+$P(PSADATA,"^",5)),PSALEN=$L($P(PSANPOU,".")),(PSAPOU,PSANPOU)=$J(PSANPOU,PSALEN,2)
|
|
S PSAVSN=$P(PSADATA,"^",12)
|
|
S PSALOC=$S(+PSACS:+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5))
|
|
TEMP S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
|
|
S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4)
|
|
S PSADUOU=$S(+PSADUOU:+PSADUOU,+PSASUB&(+$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7),1:1)
|
|
S PSADUREC=$S(PSADUOU:PSAQTY*PSADUOU,1:0)
|
|
;
|
|
;DAVE B (18NOV98)
|
|
;I PSADUREC=0,$D(PSAQTY),$P($G(^PSDRUG(PSADRG,660)),"^",5)'="" S PSADUREC=(PSAQTY*($P(^PSDRUG(PSADRG,660),"^",5)))
|
|
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)
|
|
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)
|
|
S ITM(.01)=PSALINE,ITM(1)=PSADRG,ITM(2)=PSAQTY,ITM(3)=PSAOU,ITM(4)=PSANPOU,ITM(13)=PSANDC,ITM(10)=PSADUOU
|
|
S IENS=PSALINE_","_PSAIEN1_","_PSAIEN
|
|
F X=5,6,7,8,12,14,15,16,17 S ITM(X)=$$GET1^DIQ(58.81125,IENS,X,FORM)
|
|
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
|
|
Q
|