PSAUP8 ;VMP/PW-ORDER UNIT AUTO UPDATE FOR MCKESSON ;9/19/2004 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**48**;10/24/97 ; to be identical to PSABRKU9 ;References to ^PSDRUG( are covered by IA #2095 Q OUAUTO ;EP for Order Unit Auto Update from PSAUP5 ; needs PSACTRL PSALINE from PSAUP5 ; PSAI - invoice PSAD - drug EN N DRDA,DROUDA,DROUNM,DRDUOU,INVOUNM,INVOUDA,INVDUOU,XX N PSADATA,VSNDUOU,VSNDRDA,VSDSYNDA,VSNDRD0,VSNSYND0,VCNT N INVOUNM,SYNDA,IVSN,IVSN0,SYN0,SYNDUOU,SYNIEN,VSNIEN,VSNSYNDA S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE) S PSADATA=$$PSADATA() S ^XTMP("PSAPV",PSACTRL,"IT",PSALINE)=PSADATA ;adj invoice OU, DUOU w postmaster Q PSADATA() ;extrensic return PSADATA modified S XX=PSADATA,(VSNDUOU,SYNDUOU,DRDUOU)="" S INVOUNM=$P(XX,U,2) S:INVOUNM["~" INVOUNM=$P(INVOUNM,"~") S DRDA=$P(XX,U,6),SYNDA=$P(XX,U,7),IVSN0=$P(XX,U,5) S DRDUOU=$$GET1^DIQ(50,DRDA,15) VSN ;set VSNDUOU= PSDRUG( unique VSN value or XTMP( value S IVSN=$S(IVSN0["~":$P(IVSN0,"~"),1:IVSN0) S (VSNDRDA,VCNT)=0 F S VSNDRDA=$O(^PSDRUG("AVSN",IVSN,VSNDRDA)) Q:VSNDRDA'>0 D .S VSNSYNDA=0 F S VSNSYNDA=$O(^PSDRUG("AVSN",IVSN,VSNDRDA,VSNSYNDA)) Q:VSNSYNDA'>0 S VCNT=VCNT+1 S VSNDRD0=VSNDRDA,VSNSYND0=VSNSYNDA I ((IVSN0["~")!(VCNT'=1)) I $D(^XTMP("PSAVSN",IVSN)) S VSNDUOU=^(IVSN) I 1 E D .I VCNT'=1 Q .; FYI both SYN and VSN values should be comming from the same Synonym .S VSNIEN=VSNSYND0_","_VSNDRD0 .S VSNDUOU=$$GET1^DIQ(50.1,VSNIEN,403) I VSNDUOU="",$D(^XTMP("PSAVSN",IVSN)) S VSNDUOU=^(IVSN) ; SYNDUOU ;set SYNDUOU= to PSDRUG( or XTMP value S SYNIEN=SYNDA_","_DRDA S SYNDUOU=$$GET1^DIQ(50.1,SYNIEN,403) I '$L(SYNDUOU),$D(^XTMP("PSAVSN",IVSN)) S SYNDUOU=^(IVSN) D . I SYNDUOU'=DRDUOU Q . L +^PSDRUG(DRDA,1,SYNDA,0):10 Q:'$T . S SYN0=^PSDRUG(DRDA,1,SYNDA,0) . S $P(SYN0,U,7)=SYNDUOU,^PSDRUG(DRDA,1,SYNDA,0)=SYN0 . L -^PSDRUG(DRDA,1,SYNDA,0) ; TESTDUOU ; test if DUOUs are = I VSNDUOU=SYNDUOU,SYNDUOU=DRDUOU I 1 E D G Q ; DUOUs '= but maybe VSN & SYN agree, set into IT . I '$L(VSNDUOU) Q . I VSNDUOU=SYNDUOU S $P(XX,U,20)=VSNDUOU,PSADATA=XX SETDUOU S $P(XX,U,20)=DRDUOU,PSADATA=XX ;set DUOU into PSAPV "IT" ;test for OU change CHKOU S DROUNM=$$GET1^DIQ(50,DRDA,12) S DROUDA=$$GET1^DIQ(50,DRDA,12,"I") I $E(INVOUNM,1,2)'="EA" G Q S $P(XX,U,12)=DROUDA,$P(XX,U,13)=.5,$P(XX,U,14)=DT S PSADATA=XX Q ;W ! ZW VSNDUOU,SYNDUOU,DRDUOU,PSADATA W ! Q PSADATA