source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUTL6.m@ 841

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