Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSAUP8

PSAUP8.m

Go to the documentation of this file.
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