source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUP8.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1PSAUP8 ;VMP/PW-ORDER UNIT AUTO UPDATE FOR MCKESSON ;9/19/2004
2 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**48**;10/24/97
3 ; to be identical to PSABRKU9
4 ;References to ^PSDRUG( are covered by IA #2095
5 Q
6OUAUTO ;EP for Order Unit Auto Update from PSAUP5
7 ; needs PSACTRL PSALINE from PSAUP5
8 ; PSAI - invoice PSAD - drug
9EN 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
16PSADATA() ;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)
21VSN ;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 ;
33SYNDUOU ;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 ;
43TESTDUOU ; 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
48SETDUOU S $P(XX,U,20)=DRDUOU,PSADATA=XX ;set DUOU into PSAPV "IT"
49 ;test for OU change
50CHKOU 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
55Q ;W ! ZW VSNDUOU,SYNDUOU,DRDUOU,PSADATA W !
56 Q PSADATA
Note: See TracBrowser for help on using the repository browser.