source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSWRNA.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1PSSWRNA ;BIR/EJW-API TO RETRIEVE WARNING LABEL LIST ;04/09/04
2 ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97
3 ;
4 ;Reference to ^PSNDF(50.68 supported by DBIA 3735
5 ;Reference to ^PS(50.625 supported by DBIA 4445
6 ;Reference to ^PS(50.626 supported by DBIA 4446
7 ;Reference to ^PS(50.627 supported by DBIA 4448
8DRUG(XX,DFN) ; Return warning labels numbers associated with this drug
9 ;
10 ; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
11 ; Calling method: S WARN=$$DRUG^PSSWRNA(DRUG,DFN)
12 ;
13 ; Input: DRUG = IEN from the DRUG file (50) ** REQUIRED **
14 ; Input: DFN = IEN from the PATIENT file (2) ** OPTIONAL **
15 ;
16 ; Output: WARN = List of warning numbers, separated by commas, associated with this drug. Warning numbers from the new data source will be followed by an "N".
17 ;
18 N I,PSSWSITE
19 S PSSWRN=""
20 S PSSWSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSWSITE,10)),"^",9)="N" D WARNLST
21 I PSSWRN="" S PSSWRN=$P($G(^PSDRUG(XX,0)),"^",8)
22 D CHECKLST
23 D CHECK20
24 Q PSSWRN
25 ;
26CHECK20 ; WARNING LABEL 20 - 'DO NOT TRANSFER' REQUIRED FOR CONTROLLED SUBSTANCES
27 N I
28 S DEA=$P($G(^PSDRUG(XX,0)),"^",3)
29 I DEA="" Q
30 I "12345"'[$E(DEA) Q
31 I ","_$P(PSSWRN,",",1,5)_","[",20," Q
32 I $L(PSSWRN,",")<5 S PSSWRN=$S(PSSWRN="":20,1:PSSWRN_",20") Q
33 S PSSWRN=$P(PSSWRN,",",1,4)_",20,"_$P(PSSWRN,",",5,99)
34 F I=6:1:$L(PSSWRN,",") I $P(PSSWRN,",",I)=20 S PSSWRN=$P(PSSWRN,",",1,I-1) I $P(PSSWRN,",",I+1,99)'="" S PSSWRN=PSSWRN_","_$P(PSSWRN,",",I+1,99)_$P(PSSWRN,",",I+1,99) Q
35 Q
36 ;
37WARNLST ; GET WARNING LIST FROM NEW DATA SOURCE OR USER-DEFINED NEW WARNING LABEL LIST
38 S PSSWRN=$P($G(^PSDRUG(XX,"WARN")),"^") I PSSWRN'="" Q
39 ; GET WARNINGS FROM NEW COMMERCIAL SOURCE
40 N PSOPROD,GCNSEQNO,SEQ,NEWWARN,I
41 S PSOPROD=$P($G(^PSDRUG(XX,"ND")),"^",3) I PSOPROD="" Q
42 S GCNSEQNO=$$GET1^DIQ(50.68,PSOPROD,11,"I")
43 I GCNSEQNO="" Q
44GCN S I="" F S I=$O(^PS(50.627,"B",GCNSEQNO,I)) Q:'I I I D
45 .S NEWWARN=$G(^PS(50.627,I,0)) I $P(NEWWARN,"^")=GCNSEQNO S SEQ=+$P(NEWWARN,"^",3) I SEQ>0 S NEWWARN(SEQ)=+$P(NEWWARN,"^",2)
46 S SEQ=0 F S SEQ=$O(NEWWARN(SEQ)) Q:'SEQ S PSSWRN=$S(PSSWRN'="":PSSWRN_",",1:"")_NEWWARN(SEQ)_"N"
47 Q
48WARN54 ; VERIFY ENTRY EXISTS. IF NOT, REMOVE FROM WARNING LIST
49 I '$D(^PS(54,WARN,1)) S PSSWRN=$P(PSSWRN,",",1,I-1)_$S(I=1:"",1:",")_$P(PSSWRN,",",I+1,99),I=I-1
50 Q
51NEWWARN ;
52 I '$D(^PS(50.625,WARN,1)) S PSSWRN=$P(PSSWRN,",",1,I-1)_$S(I=1:"",1:",")_$P(PSSWRN,",",I+1,99),I=I-1
53 Q
54CHECKLST ;
55 N WARN
56 F I=1:1:$L(PSSWRN,",") S WARN=$P(PSSWRN,",",I) I WARN'="" D
57 .I WARN'["N" D WARN54 Q
58 .S WARN=+WARN D GENDER I WARN'="" D NEWWARN
59 I $E(PSSWRN,$L(PSSWRN))="," S PSSWRN=$E(PSSWRN,1,($L(PSSWRN)-1))
60 Q
61GENDER ;
62 I $G(DFN)="" Q
63 N SEX,GENDER
64 S GENDER=$$GET1^DIQ(50.625,WARN,2,"I") I GENDER="" Q
65 I GENDER'="F",GENDER'="M" Q
66 S SEX=$$GET1^DIQ(2,DFN,.02,"I")
67 I $G(SEX)="" Q
68 I SEX'="F",SEX'="M" Q
69 I SEX'=GENDER,$$GET1^DIQ(50,XX,8.2,"I")="N" D
70 .S PSSWRN=$P(PSSWRN,",",1,I-1)_$S(I=1:"",1:",")_$P(PSSWRN,",",I+1,99),I=I-1
71 Q
72WTEXT(WARN,LAN) ;
73 ;
74 ; entry point from Outpatient Pharmacy and Consolidated Mail Outpatient Pharmacy
75 ; Calling method: S TEXT=$$WTEXT^PSSWRNA(WARN,LAN)
76 ;
77 ; Input: WARN = A warning label number from the old RX Consult file (#54) or the new WARNING LABEL-ENGLISH file (#50.625) followed by an "N". ** REQUIRED **
78 ; Note: there is a one-to-one correspondence for entries in the WARNING LABEL-ENGLISH file (#50.625) and the WARNING LABEL-SPANISH file (#50.626).
79 ;
80 ; LAN = Patient's PMI language preference. 2=Spanish. Anything less than 2 is English ** OPTIONAL **
81 ;
82 ; Output: TEXT = Warning label text for the warning number. If LAN=2 the text will be returned in Spanish if a translation is available, otherwise the text will be returned in English.
83 ;
84 S TEXT=""
85 I WARN'["N" D
86 . I $G(LAN)=2 D
87 .. I $D(^PS(54,WARN,3)) S TEXT=^(3)
88 . I TEXT="" S JJJ=0 F S JJJ=$O(^PS(54,WARN,1,JJJ)) Q:('JJJ) D
89 .. I $D(^PS(54,WARN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
90 I WARN["N" D
91 .I $G(LAN)'=2 D Q
92 .. S PSOWRNN=+WARN I $D(^PS(50.625,PSOWRNN)) D
93 ... S TEXT="",JJJ=0
94 ... F S JJJ=$O(^PS(50.625,PSOWRNN,1,JJJ)) Q:('JJJ) D
95 .... I $D(^PS(50.625,PSOWRNN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
96 . S PSOWRNN=+WARN I $D(^PS(50.626,PSOWRNN)) D
97 .. S TEXT="",JJJ=0
98 .. F S JJJ=$O(^PS(50.626,PSOWRNN,1,JJJ)) Q:('JJJ) D
99 ... I $D(^PS(50.626,PSOWRNN,1,JJJ,0)) S TEXT=TEXT_$S(TEXT="":"",1:" ")_^(0)
100 Q TEXT
101 ;
102GENDER2 ;
103 N I,WARN
104 S GENDER=""
105 I $G(PSSWRN)'["N" Q
106 F I=1:1 S WARN=$P(PSSWRN,",",I) Q:WARN="" D Q:GENDER'=""
107 .I WARN'["N" Q
108 .S WARN=+WARN,GENDER=$$GET1^DIQ(50.625,WARN,2,"I")
109 Q
110 ;
Note: See TracBrowser for help on using the repository browser.