| 1 | PSABRKU9 ;VMP/PW-ORDER UNIT AUTO UPDATE FOR MCKESSON ;9/19/2004
|
|---|
| 2 | ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**48**;10/24/97
|
|---|
| 3 | ;routine to be identical to PSAUP8
|
|---|
| 4 | ;References to ^PSDRUG( are covered by IA #2095
|
|---|
| 5 | Q
|
|---|
| 6 | OUAUTO ;EP for Order Unit Auto Update from PSABRKU6
|
|---|
| 7 | ; needs PSACTRL PSALINE from PSABRKU6
|
|---|
| 8 | ; PSAI - invoice PSAD - drug
|
|---|
| 9 | EN N DRDA,DROUDA,DROUNM,DRDUOU,INVOUNM,INVOUDA,INVDUOU,XX
|
|---|
| 10 | N PSADATA,VSNDUOU,VSNDRDA,VSDSYNDA,VSNDRD0,VSNSYND0,VCNT
|
|---|
| 11 | N INVOUNM,SYNDA,IVSN,IVSN0,SYN0,SYNDUOU,SYNIEN,VSNIEN,VSNSYNDA
|
|---|
| 12 | S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
|
|---|
| 13 | S PSADATA=$$PSADATA()
|
|---|
| 14 | S ^XTMP("PSAPV",PSACTRL,"IT",PSALINE)=PSADATA ;adj invoice OU, DUOU w postmaster
|
|---|
| 15 | Q
|
|---|
| 16 | PSADATA() ;extrensic return PSADATA modified
|
|---|
| 17 | S XX=PSADATA,(VSNDUOU,SYNDUOU,DRDUOU)=""
|
|---|
| 18 | S INVOUNM=$P(XX,U,2) S:INVOUNM["~" INVOUNM=$P(INVOUNM,"~")
|
|---|
| 19 | S DRDA=$P(XX,U,6),SYNDA=$P(XX,U,7),IVSN0=$P(XX,U,5)
|
|---|
| 20 | S DRDUOU=$$GET1^DIQ(50,DRDA,15)
|
|---|
| 21 | VSN ;set VSNDUOU= PSDRUG( unique VSN value or XTMP( value
|
|---|
| 22 | S IVSN=$S(IVSN0["~":$P(IVSN0,"~"),1:IVSN0)
|
|---|
| 23 | S (VSNDRDA,VCNT)=0 F S VSNDRDA=$O(^PSDRUG("AVSN",IVSN,VSNDRDA)) Q:VSNDRDA'>0 D
|
|---|
| 24 | .S VSNSYNDA=0 F S VSNSYNDA=$O(^PSDRUG("AVSN",IVSN,VSNDRDA,VSNSYNDA)) Q:VSNSYNDA'>0 S VCNT=VCNT+1 S VSNDRD0=VSNDRDA,VSNSYND0=VSNSYNDA
|
|---|
| 25 | I ((IVSN0["~")!(VCNT'=1)) I $D(^XTMP("PSAVSN",IVSN)) S VSNDUOU=^(IVSN) I 1
|
|---|
| 26 | E D
|
|---|
| 27 | .I VCNT'=1 Q
|
|---|
| 28 | .; FYI both SYN and VSN values should be comming from the same Synonym
|
|---|
| 29 | .S VSNIEN=VSNSYND0_","_VSNDRD0
|
|---|
| 30 | .S VSNDUOU=$$GET1^DIQ(50.1,VSNIEN,403)
|
|---|
| 31 | I VSNDUOU="",$D(^XTMP("PSAVSN",IVSN)) S VSNDUOU=^(IVSN)
|
|---|
| 32 | ;
|
|---|
| 33 | SYNDUOU ;set SYNDUOU= to PSDRUG( or XTMP value
|
|---|
| 34 | S SYNIEN=SYNDA_","_DRDA
|
|---|
| 35 | S SYNDUOU=$$GET1^DIQ(50.1,SYNIEN,403)
|
|---|
| 36 | I '$L(SYNDUOU),$D(^XTMP("PSAVSN",IVSN)) S SYNDUOU=^(IVSN) D
|
|---|
| 37 | . I SYNDUOU'=DRDUOU Q
|
|---|
| 38 | . L +^PSDRUG(DRDA,1,SYNDA,0):10 Q:'$T
|
|---|
| 39 | . S SYN0=^PSDRUG(DRDA,1,SYNDA,0)
|
|---|
| 40 | . S $P(SYN0,U,7)=SYNDUOU,^PSDRUG(DRDA,1,SYNDA,0)=SYN0
|
|---|
| 41 | . L -^PSDRUG(DRDA,1,SYNDA,0)
|
|---|
| 42 | ;
|
|---|
| 43 | TESTDUOU ; test if DUOUs are =
|
|---|
| 44 | I VSNDUOU=SYNDUOU,SYNDUOU=DRDUOU I 1
|
|---|
| 45 | E D G Q ; DUOUs '= but maybe VSN & SYN agree, set into IT
|
|---|
| 46 | . I '$L(VSNDUOU) Q
|
|---|
| 47 | . I VSNDUOU=SYNDUOU S $P(XX,U,20)=VSNDUOU,PSADATA=XX
|
|---|
| 48 | SETDUOU S $P(XX,U,20)=DRDUOU,PSADATA=XX ;set DUOU into PSAPV "IT"
|
|---|
| 49 | ;test for OU change
|
|---|
| 50 | CHKOU S DROUNM=$$GET1^DIQ(50,DRDA,12)
|
|---|
| 51 | S DROUDA=$$GET1^DIQ(50,DRDA,12,"I")
|
|---|
| 52 | I $E(INVOUNM,1,2)'="EA" G Q
|
|---|
| 53 | S $P(XX,U,12)=DROUDA,$P(XX,U,13)=.5,$P(XX,U,14)=DT
|
|---|
| 54 | S PSADATA=XX
|
|---|
| 55 | Q ;W ! ZW VSNDUOU,SYNDUOU,DRDUOU,PSADATA W !
|
|---|
| 56 | Q PSADATA
|
|---|
