source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSWRNE.m

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1PSSWRNE ;BIR/EJW-NEW WARNING SOURCE NEW WARNING LABEL LIST EDITOR ;05/24/04
2 ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97
3 ;
4 ;Reference to ^PS(50.625 supported by DBIA 4445
5EDIT ;
6 N STAR,QUIT,PSSOUT
7 S QUIT=0,STAR="",PSSOUT=0
8 S DRUG="" F S DRUG=$O(^TMP("PSSWRNB",$J,DRUG)) Q:DRUG="" D I QUIT Q
9 .S DRUGN=$O(^PSDRUG("B",DRUG,0)) Q:'DRUGN D DEA,PRINT
10 Q
11 ;
12PRINT ;
13 N NEWLIST,STAR
14 I '$G(PSSLOOK) D
15 .W @IOF
16 .W "Current Warning labels for ",DRUG
17 .I $G(NEWLIST)="",PSSWRN'["N" W !,"No warnings from the new data source exist for this drug." D
18 ..W !,"Verify that the drug is matched to the National Drug File."
19 I PSSWRN'="" D
20 .I '$G(PSSLOOK) W !,"Labels will print in the order in which they appear for local and CMOP fills:"
21 .I '$G(ENDWARN) S ENDWARN=5
22 .S STAR=""
23 .F WWW=1:1:ENDWARN S PSOWARN=$P(PSSWRN,",",WWW) Q:PSOWARN="" D
24 ..I WWW>5 S STAR="*"
25 ..I PSOWARN["N" D NEWWARN Q
26 ..D WARN54
27 .D FULL Q:$G(PSSOUT) W !!,"Pharmacy fill card display: DRUG WARNING ",PSSWRN
28 .I $G(PSSLOOK) Q
29 .I $G(SEL)=6 D
30 ..S WARN54=$G(^TMP("PSSWRNB",$J,DRUG))
31 ..D FULL W !," RX CONSULT file Drug Warning="_WARN54
32 ..N I,WARN F I=1:1:$L(WARN54,",") S WARN=$P(WARN54,",",I) I WARN'="",$G(^PS(54,WARN,2))="" D FULL W !," ",WARN_" "_$G(^PS(54,WARN,0))_" is not mapped to the new data source"
33 .I $G(SEL)=8 D
34 ..W !
35 ..S DIE="^PSDRUG(",DA=DRUGN,DR=8.2 D ^DIE K DIE,DA,DR
36 .S NEWLIST=$P($G(^PSDRUG(DRUGN,"WARN")),"^") I NEWLIST="" D
37 ..I PSSWRN'["N" Q
38 ..D FULL Q:$G(PSSOUT) W !,"NOTE: Because the NEW WARNING LABEL LIST field is empty, the warnings above"
39 ..D FULL Q:$G(PSSOUT) W !,"are the warnings that our national data source distributes for this drug."
40 I $G(PSSLOOK) Q
41 I $G(NEWLIST)'="" D FULL Q:$G(PSSOUT) W !,"NEW WARNING LABEL LIST: ",NEWLIST
42 D FULL Q:$G(PSSOUT) W ! K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")="Would you like to edit this list of warnings" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S QUIT=1
43 I 'Y D Q
44 .I $G(DRUGENT) S WARNEDIT=0 K ^TMP("PSSWRNB",$J)
45 I $G(DRUGENT) S WARNEDIT=1 K ^TMP("PSSWRNB",$J) Q
46 S OLDWARN=PSSWRN
47 S DIE="^PSDRUG(",DA=DRUGN,DR=8.1 D ^DIE K DIE,DA,DR
48 S PSSWRN=$P($G(^PSDRUG(DRUGN,"WARN")),"^") I PSSWRN'="" D CHECK20^PSSWRNA G PRINT
49 I $G(OLDWARN)'="",PSSWRN="" D DEA G PRINT
50 Q
51FULL ;
52 I ($Y+3)>IOSL&('$G(PSSOUT)) D HDR
53 Q
54NEWWARN ;
55 N PSOWRNN,JJJ,STR
56 S TEXT=""
57 S PSOWRNN=+PSOWARN I $D(^PS(50.625,PSOWRNN)) D
58 .I '$G(PSSLOOK) W !
59 .S TEXT=STAR_PSOWARN_" "
60 .S JJJ=0 F S JJJ=$O(^PS(50.625,PSOWRNN,1,JJJ)) Q:'JJJ S STR=$G(^PS(50.625,PSOWRNN,1,JJJ,0)) S TEXT=TEXT_" "_STR
61 I TEXT'="" D FORMAT I $G(PSSLOOK) D FULL^PSSLOOK
62 Q
63WARN54 ;
64 S TEXT=""
65 I $D(^PS(54,PSOWARN,1)) D
66 .I '$G(PSSLOOK) W !
67 .S TEXT=STAR_PSOWARN_" "
68 .S JJJ=0 F S JJJ=$O(^PS(54,PSOWARN,1,JJJ)) Q:'JJJ S TEXT=TEXT_" "_$G(^PS(54,PSOWARN,1,JJJ,0))
69 I TEXT'="" D FORMAT I $G(PSSLOOK) D FULL^PSSLOOK
70 Q
71VALID ; VALIDATE NEW WARNING LABEL LIST
72 N BAD
73 S BAD=0
74 I $G(X)="" W !,"TOO MANY WARNINGS. LIMIT ANSWER STRING TO 30 CHARACTERS OR LESS" K Y Q
75 F I=1:1:$L(X,",") S PSOWARN=$P(X,",",I) I PSOWARN'="" D
76 .I PSOWARN["N" S PSOWRNN=+PSOWARN D Q
77 ..I '$D(^PS(50.625,PSOWRNN)) W !,PSOWARN," does not exist in the WARNING LABEL-ENGLISH file" S BAD=1
78 .I '$D(^PS(54,PSOWARN)) W !,PSOWARN," does not exist in the RX CONSULT file" S BAD=1
79 I BAD K X
80 Q
81FORMAT ;
82 N I,LEN,PTEXT
83 S LEN=0,PTEXT=""
84 F I=1:1:$L(TEXT," ") S STR=$P(TEXT," ",I)_" " D
85 .I LEN+$L(STR)<80 S PTEXT=PTEXT_STR,LEN=LEN+$L(STR) Q
86 .S LEN=0,I=I-1 D FULL Q:$G(PSSOUT) W !,PTEXT S PTEXT=""
87 I PTEXT'="" D FULL Q:$G(PSSOUT) W !,PTEXT S PTEXT=""
88 Q
89 ;
90NOTE ;
91 N PSSWSITE
92 S PSSWSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSWSITE,10)),"^",9)'="N" D
93 .W !,?2,"NOTE: You must edit the WARNING LABEL SOURCE field using the option"
94 .W !,?2,"Pharmacy System Parameters Edit to enable national warning labels."
95 Q
96 ;
97DEA ;
98 S DEA=$P($G(^PSDRUG(DRUGN,0)),"^",3)
99 S XX=DRUGN D WARNLST^PSSWRNA S:PSSWRN="" PSSWRN=$P($G(^PSDRUG(DRUGN,0)),"^",8)
100 D CHECK20^PSSWRNA,CHECKLST^PSSWRNA
101 Q
102 ;
103HDR ;
104 K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1,QUIT=1 Q
105 W @IOF
106 W "Current Warning labels for ",DRUG," (continued)"
107 Q
108 ;
109NOTE2 W !!,?5,"The RX CONSULT File (#54) contains local label expansions."
110 W !,?5,"The WARNING LABEL-ENGLISH file (#50.625) contains national label"
111 W !,?5,"expansions in English."
112 W !,?5,"The WARNING LABEL-SPANISH file (#50.626) contains national label"
113 W !,?5,"expansions in Spanish."
114 W !,?5,"It is important to note that RX Consult entry numbers do not"
115 W !,?5,"correlate with the other files (i.e. Number 7 in file 54 is not"
116 W !,?5,"included in file 50.625)."
117 W !!,?5,"You should print a list of the current RX CONSULT file entries"
118 W !,?5,"and the current WARNING LABEL-ENGLISH file entries."
119 W !
120 Q
Note: See TracBrowser for help on using the repository browser.