source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSVX61.m@ 1639

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

revised back to 6/30/08 version

File size: 972 bytes
RevLine 
[623]1PSSVX61 ; COMPILED XREF FOR FILE #52.6 ; 04/10/06
[613]2 ;
3 S DIKZK=2
4 S DIKZ(0)=$G(^PS(52.6,DA,0))
5 S X=$P(DIKZ(0),U,2)
6 I X'="" K ^PS(52.6,"AC",$E(X,1,30),DA)
7 S X=$P(DIKZ(0),U,2)
8 I X'="" I '$D(^PS(52.7,"AC",X)) S XX=$O(^PS(52.6,"AC",X,0)) S:XX=DA XX=$O(^(XX)) I XX,$P($G(^PSDRUG(X,2)),"^",3)["I" S PSIUDA=X,PSIUX="I" D END^PSSGIU
9 S X=$P(DIKZ(0),U,2)
10 I X'="" D
11 .N DIK,DIV,DIU,DIN
12 .S DIU=$P($G(^PS(52.6,DA,0)),U,12) I DIU]"" S $P(^(0),U,12)="" I $O(^DD(52.6,16,1,0)) K DIV S (DIV,X)="",(D0,DIV(0))=DA,DIH=52.6,DIG=16 D ^DICR
13 S X=$P(DIKZ(0),U,2)
14 I X'="" D K526^PSSPOID1
15 S DIKZ("I")=$G(^PS(52.6,DA,"I"))
16 S X=$P(DIKZ("I"),U,1)
17 I X'="" X ^DD(52.6,12,1,1,2)
18 S DIKZ(0)=$G(^PS(52.6,DA,0))
19 S X=$P(DIKZ(0),U,11)
20 I X'="" K ^PS(52.6,"AOI",$E(X,1,30),DA)
21 S X=$P(DIKZ(0),U,12)
22 I X'="" K ^PS(52.6,"APD",$E(X,1,30),DA)
23 S X=$P(DIKZ(0),U,13)
24 I X'="" X ^DD(52.6,17,1,1,2)
25 S DIKZ(0)=$G(^PS(52.6,DA,0))
26 S X=$P(DIKZ(0),U,1)
27 I X'="" K ^PS(52.6,"B",$E(X,1,30),DA)
28END G ^PSSVX62
Note: See TracBrowser for help on using the repository browser.