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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAUTL6 4277 printed Apr 09, 2024@20:54:58 Page 2
PSAUTL6 ;VMP/PDW-PULL ORDER INVOICE LINE ITEM DATA ;03/28/2005
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**42**; 10/24/97
+2 ;References to ^PSDRUG( are covered by IA #2095
+3 ;
ITEM(PSAIEN,PSAIEN1,PSALINE,ITM,FORM) ;RETURN LINE ITEM INFO with data adjusted IN .ITM array by reference
+1 ;PSAIEN - Order IEN, PSAIEN1 - Invoice IEN, PSALINE - Item IEN
+2 ; FORM="I" INTERNAL VALUE, ="" EXTERNAL VALUE
+3 ; ITM return array pass by reference ITM(field number #)= value
+4 ; .01-Line, 1-Drug, 2-QTY, 3-OU, 4-PPOU, 5-DtProc, 6-Proc, 7-DtVer
+5 ; 8-Ver, 10-DUOU, 11-ReOrd Lev, 12-CS, 13-NDC(-), 14-VSN, 15-UPC
+6 ; 16-Syn Node, 17-Stock Lev
+7 ; code borrowed from PSAVER6 March 25,2005
+8 NEW PSACOST,PSACS,PSADASH,PSADATA,PSADJ,PSADJD,PSADJO,PSADJP,PSADJQ
+9 NEW PSADRG,PSADT,PSADUOU,PSADUQTY,PSADUREC,PSAIN,PSAINV,PSAINVDT,PSALEN,PSALOC,PSAMSG,PSANDC,PSANODE,PSANPDU,PSANPOU
+10 NEW PSAODASH,PSAONDC,PSAORD,PSAOU,PSAPDU,PSAPOU,PSAQTY,PSAREORD,PSASET,PSASTOCK,PSASUP,PSAT,PSATDRG,PSATEMP,PSAVBKG,PSAVDUZ,PSAVEND,PSAVSN,X
+11 NEW PSA0QTY,PSASUB,IENS
+12 IF '$LENGTH($GET(FORM))
SET FORM=""
+13 SET PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
+14 SET PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
+15 SET PSAVDUZ=$PIECE(PSADATA,"^",9)
SET PSASUP=0
+16 SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
+17 IF '$GET(PSADJ)
SET PSADRG=$SELECT(+$PIECE(PSADATA,"^",2):+$PIECE(PSADATA,"^",2),1:0)
GOTO CS
+18 IF $GET(PSADJ)
Begin DoDot:1
+19 SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
+20 SET PSADJD=$SELECT($PIECE(PSANODE,"^",6)'="":$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+21 IF PSADJD'?1.N
SET PSASUP=1
+22 SET PSADRG=$SELECT(PSADJ&('PSASUP):+PSADJD,PSADJ&(PSASUP):$GET(PSADJD),1:+$PIECE(PSADATA,"^",2))
+23 IF +PSADJD
IF $GET(PSADJD)=+$GET(PSADJD)
IF $PIECE($GET(^PSDRUG(+PSADJD,0)),"^")'=""
SET PSADRG=+PSADJD
QUIT
+24 IF +PSADJD
IF $GET(PSADJD)=+$GET(PSADJD)
IF $PIECE($GET(^PSDRUG(+PSADJD,0)),"^")=""
SET (PSADJ,PSADRG)=0
QUIT
End DoDot:1
CS ;Q:PSASUP!('PSADRG)
+1 SET PSACS=$SELECT(+$PIECE(PSADATA,"^",10):1,1:0)
+2 SET PSADJQ=0
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
+3 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJQ=$SELECT($PIECE(PSANODE,"^",6)'="":+$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+4 ;
+5 ;PSA*3*1 (DAVE B)
+6 SET PSAQTY=$SELECT(($GET(PSADJQ)'=""&(+PSADJ)):PSADJQ,1:+$PIECE(PSADATA,"^",3))
+7 SET PSAOU=$SELECT(+$PIECE(PSADATA,"^",4):+$PIECE(PSADATA,"^",4),1:"")
+8 ;
+9 ;DAVE B (PSA*3*3)
+10 ;I +$P($P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)),"^",5),"~",2) S PSAOU=$P($P($G(^(2)),"^",5),"~",2)
+11 ;
+12 SET PSADJO=0
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
+13 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJO=$SELECT($PIECE(PSANODE,"^",6)'="":$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+14 if $GET(PSADJO)
SET PSAOU=$GET(PSADJO)
+15 SET PSANDC=$PIECE(PSADATA,"^",11)
IF FORM=""
DO PSANDC1^PSAHELP
SET PSANDC=PSANDCX
KILL PSANDCX
+16 SET PSADJP=0
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
+17 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJP=$SELECT(+$PIECE(PSANODE,"^",6):+$PIECE(PSANODE,"^",6),1:+$PIECE(PSANODE,"^",2))
+18 SET (PSAPOU,PSANPOU)=$SELECT($GET(PSADJP):PSADJP,1:+$PIECE(PSADATA,"^",5))
SET PSALEN=$LENGTH($PIECE(PSANPOU,"."))
SET (PSAPOU,PSANPOU)=$JUSTIFY(PSANPOU,PSALEN,2)
+19 SET PSAVSN=$PIECE(PSADATA,"^",12)
+20 SET PSALOC=$SELECT(+PSACS:+$PIECE(PSAIN,"^",12),1:+$PIECE(PSAIN,"^",5))
TEMP SET PSATEMP=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
+1 SET PSADUOU=+$PIECE(PSATEMP,"^")
SET PSAREORD=+$PIECE(PSATEMP,"^",2)
SET PSASUB=+$PIECE(PSATEMP,"^",3)
SET PSASTOCK=+$PIECE(PSATEMP,"^",4)
+2 SET PSADUOU=$SELECT(+PSADUOU:+PSADUOU,+PSASUB&(+$PIECE($GET(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7)):+$PIECE($GET(^PSDRUG(PSADRG,1,PSASUB,0)),"^",7),1:1)
+3 SET PSADUREC=$SELECT(PSADUOU:PSAQTY*PSADUOU,1:0)
+4 ;
+5 ;DAVE B (18NOV98)
+6 ;I PSADUREC=0,$D(PSAQTY),$P($G(^PSDRUG(PSADRG,660)),"^",5)'="" S PSADUREC=(PSAQTY*($P(^PSDRUG(PSADRG,660),"^",5)))
+7 SET PSAREORD=$SELECT(+PSAREORD:+PSAREORD,+$PIECE($GET(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",5):+$PIECE($GET(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",5),1:0)
+8 SET PSASTOCK=$SELECT(+PSASTOCK:+PSASTOCK,+$PIECE($GET(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",3):+$PIECE($GET(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",3),1:0)
+9 SET ITM(.01)=PSALINE
SET ITM(1)=PSADRG
SET ITM(2)=PSAQTY
SET ITM(3)=PSAOU
SET ITM(4)=PSANPOU
SET ITM(13)=PSANDC
SET ITM(10)=PSADUOU
+10 SET IENS=PSALINE_","_PSAIEN1_","_PSAIEN
+11 FOR X=5,6,7,8,12,14,15,16,17
SET ITM(X)=$$GET1^DIQ(58.81125,IENS,X,FORM)
+12 ;also handle supply items ITM(1)=supply item name
IF FORM'="I"
SET ITM(3)=$$GET1^DIQ(51.5,ITM(3),.01)
if +ITM(1)=ITM(1)
SET ITM(1)=$$GET1^DIQ(50,ITM(1),.01)
+13 QUIT
