PSABRKU9 ;VMP/PW-ORDER UNIT AUTO UPDATE FOR MCKESSON ;9/19/2004
;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**48**;10/24/97
;routine to be identical to PSAUP8
;References to ^PSDRUG( are covered by IA #2095
Q
OUAUTO ;EP for Order Unit Auto Update from PSABRKU6
; needs PSACTRL PSALINE from PSABRKU6
; 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSABRKU9 2455 printed Nov 22, 2024@16:59:09 Page 2
PSABRKU9 ;VMP/PW-ORDER UNIT AUTO UPDATE FOR MCKESSON ;9/19/2004
+1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**48**;10/24/97
+2 ;routine to be identical to PSAUP8
+3 ;References to ^PSDRUG( are covered by IA #2095
+4 QUIT
OUAUTO ;EP for Order Unit Auto Update from PSABRKU6
+1 ; needs PSACTRL PSALINE from PSABRKU6
+2 ; PSAI - invoice PSAD - drug
EN NEW DRDA,DROUDA,DROUNM,DRDUOU,INVOUNM,INVOUDA,INVDUOU,XX
+1 NEW PSADATA,VSNDUOU,VSNDRDA,VSDSYNDA,VSNDRD0,VSNSYND0,VCNT
+2 NEW INVOUNM,SYNDA,IVSN,IVSN0,SYN0,SYNDUOU,SYNIEN,VSNIEN,VSNSYNDA
+3 SET PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
+4 SET PSADATA=$$PSADATA()
+5 ;adj invoice OU, DUOU w postmaster
SET ^XTMP("PSAPV",PSACTRL,"IT",PSALINE)=PSADATA
+6 QUIT
PSADATA() ;extrensic return PSADATA modified
+1 SET XX=PSADATA
SET (VSNDUOU,SYNDUOU,DRDUOU)=""
+2 SET INVOUNM=$PIECE(XX,U,2)
if INVOUNM["~"
SET INVOUNM=$PIECE(INVOUNM,"~")
+3 SET DRDA=$PIECE(XX,U,6)
SET SYNDA=$PIECE(XX,U,7)
SET IVSN0=$PIECE(XX,U,5)
+4 SET DRDUOU=$$GET1^DIQ(50,DRDA,15)
VSN ;set VSNDUOU= PSDRUG( unique VSN value or XTMP( value
+1 SET IVSN=$SELECT(IVSN0["~":$PIECE(IVSN0,"~"),1:IVSN0)
+2 SET (VSNDRDA,VCNT)=0
FOR
SET VSNDRDA=$ORDER(^PSDRUG("AVSN",IVSN,VSNDRDA))
if VSNDRDA'>0
QUIT
Begin DoDot:1
+3 SET VSNSYNDA=0
FOR
SET VSNSYNDA=$ORDER(^PSDRUG("AVSN",IVSN,VSNDRDA,VSNSYNDA))
if VSNSYNDA'>0
QUIT
SET VCNT=VCNT+1
SET VSNDRD0=VSNDRDA
SET VSNSYND0=VSNSYNDA
End DoDot:1
+4 IF ((IVSN0["~")!(VCNT'=1))
IF $DATA(^XTMP("PSAVSN",IVSN))
SET VSNDUOU=^(IVSN)
IF 1
+5 IF '$TEST
Begin DoDot:1
+6 IF VCNT'=1
QUIT
+7 ; FYI both SYN and VSN values should be comming from the same Synonym
+8 SET VSNIEN=VSNSYND0_","_VSNDRD0
+9 SET VSNDUOU=$$GET1^DIQ(50.1,VSNIEN,403)
End DoDot:1
+10 IF VSNDUOU=""
IF $DATA(^XTMP("PSAVSN",IVSN))
SET VSNDUOU=^(IVSN)
+11 ;
SYNDUOU ;set SYNDUOU= to PSDRUG( or XTMP value
+1 SET SYNIEN=SYNDA_","_DRDA
+2 SET SYNDUOU=$$GET1^DIQ(50.1,SYNIEN,403)
+3 IF '$LENGTH(SYNDUOU)
IF $DATA(^XTMP("PSAVSN",IVSN))
SET SYNDUOU=^(IVSN)
Begin DoDot:1
+4 IF SYNDUOU'=DRDUOU
QUIT
+5 LOCK +^PSDRUG(DRDA,1,SYNDA,0):10
if '$TEST
QUIT
+6 SET SYN0=^PSDRUG(DRDA,1,SYNDA,0)
+7 SET $PIECE(SYN0,U,7)=SYNDUOU
SET ^PSDRUG(DRDA,1,SYNDA,0)=SYN0
+8 LOCK -^PSDRUG(DRDA,1,SYNDA,0)
End DoDot:1
+9 ;
TESTDUOU ; test if DUOUs are =
+1 IF VSNDUOU=SYNDUOU
IF SYNDUOU=DRDUOU
IF 1
+2 ; DUOUs '= but maybe VSN & SYN agree, set into IT
IF '$TEST
Begin DoDot:1
+3 IF '$LENGTH(VSNDUOU)
QUIT
+4 IF VSNDUOU=SYNDUOU
SET $PIECE(XX,U,20)=VSNDUOU
SET PSADATA=XX
End DoDot:1
GOTO Q
SETDUOU ;set DUOU into PSAPV "IT"
SET $PIECE(XX,U,20)=DRDUOU
SET PSADATA=XX
+1 ;test for OU change
CHKOU SET DROUNM=$$GET1^DIQ(50,DRDA,12)
+1 SET DROUDA=$$GET1^DIQ(50,DRDA,12,"I")
+2 IF $EXTRACT(INVOUNM,1,2)'="EA"
GOTO Q
+3 SET $PIECE(XX,U,12)=DROUDA
SET $PIECE(XX,U,13)=.5
SET $PIECE(XX,U,14)=DT
+4 SET PSADATA=XX
Q ;W ! ZW VSNDUOU,SYNDUOU,DRDUOU,PSADATA W !
+1 QUIT PSADATA
