PSSWRNE ;BIR/EJW - NEW WARNING SOURCE NEW WARNING LABEL LIST EDITOR ;05/24/04
;;1.0;PHARMACY DATA MANAGEMENT;**87,233**;9/30/97;Build 2
;
;Reference to ^PS(50.625 supported by DBIA 4445
EN(RTN) ; Entry from ^PSSLOOK PSS*1*233
N PSSSTWN
S PSSSTWN=1
EDIT ;
N STAR,QUIT,PSSOUT
S QUIT=0,STAR="",PSSOUT=0
S DRUG="" F S DRUG=$O(^TMP("PSSWRNB",$J,DRUG)) Q:DRUG="" D I QUIT Q
.S DRUGN=$O(^PSDRUG("B",DRUG,0)) Q:'DRUGN D DEA,PRINT
I $G(PSSSTWN) S RTN=QUIT
Q
;
PRINT ;
N NEWLIST,STAR
I '$G(PSSLOOK) D
.W @IOF
.W "Current Warning labels for ",DRUG
.I $G(NEWLIST)="",PSSWRN'["N" W !,"No warnings from the new data source exist for this drug." D
..W !,"Verify that the drug is matched to the National Drug File."
I PSSWRN'="" D
.I '$G(PSSLOOK) W !,"Labels will print in the order in which they appear for local and CMOP fills:"
.I '$G(ENDWARN) S ENDWARN=5
.S STAR=""
.F WWW=1:1:ENDWARN S PSOWARN=$P(PSSWRN,",",WWW) Q:PSOWARN="" D
..I WWW>5 S STAR="*"
..I PSOWARN["N" D NEWWARN Q
..D WARN54
.Q:$G(QUIT) D FULL Q:$G(PSSOUT) W !!,"Pharmacy fill card display: DRUG WARNING ",PSSWRN
.I $G(PSSLOOK) Q
.I $G(SEL)=6 D
..S WARN54=$G(^TMP("PSSWRNB",$J,DRUG))
..D FULL W !," RX CONSULT file Drug Warning="_WARN54
..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"
.I $G(SEL)=8 D
..W !
..S DIE="^PSDRUG(",DA=DRUGN,DR=8.2 D ^DIE K DIE,DA,DR
.S NEWLIST=$P($G(^PSDRUG(DRUGN,"WARN")),"^") I NEWLIST="" D
..I PSSWRN'["N" Q
..D FULL Q:$G(PSSOUT) W !,"NOTE: Because the NEW WARNING LABEL LIST field is empty, the warnings above"
..D FULL Q:$G(PSSOUT) W !,"are the warnings that our national data source distributes for this drug."
I $G(PSSLOOK) Q
I $G(NEWLIST)'="" D FULL Q:$G(PSSOUT) W !,"NEW WARNING LABEL LIST: ",NEWLIST
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
I 'Y D Q
.I $G(DRUGENT) S WARNEDIT=0 K ^TMP("PSSWRNB",$J)
I $G(DRUGENT) S WARNEDIT=1 K ^TMP("PSSWRNB",$J) Q
S OLDWARN=PSSWRN
S DIE="^PSDRUG(",DA=DRUGN,DR=8.1 D ^DIE K DIE,DA,DR
S PSSWRN=$P($G(^PSDRUG(DRUGN,"WARN")),"^") I PSSWRN'="" D CHECK20^PSSWRNA G PRINT
I $G(OLDWARN)'="",PSSWRN="" D DEA G PRINT
Q
FULL ;
I ($Y+3)>IOSL&('$G(PSSOUT)) D HDR
Q
NEWWARN ;
N PSOWRNN,JJJ,STR
S TEXT=""
S PSOWRNN=+PSOWARN I $D(^PS(50.625,PSOWRNN)) D
.I '$G(PSSLOOK) W !
.S TEXT=STAR_PSOWARN_" "
.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
I TEXT'="" D FORMAT I $G(PSSLOOK) D FULL^PSSLOOK
Q
WARN54 ;
S TEXT=""
I $D(^PS(54,PSOWARN,1)) D
.I '$G(PSSLOOK) W !
.S TEXT=STAR_PSOWARN_" "
.S JJJ=0 F S JJJ=$O(^PS(54,PSOWARN,1,JJJ)) Q:'JJJ S TEXT=TEXT_" "_$G(^PS(54,PSOWARN,1,JJJ,0))
I TEXT'="" D FORMAT I $G(PSSLOOK) D FULL^PSSLOOK
Q
VALID ; VALIDATE NEW WARNING LABEL LIST
N BAD
S BAD=0
I $G(X)="" W !,"TOO MANY WARNINGS. LIMIT ANSWER STRING TO 30 CHARACTERS OR LESS" K Y Q
F I=1:1:$L(X,",") S PSOWARN=$P(X,",",I) I PSOWARN'="" D
.I PSOWARN["N" S PSOWRNN=+PSOWARN D Q
..I '$D(^PS(50.625,PSOWRNN)) W !,PSOWARN," does not exist in the WARNING LABEL-ENGLISH file" S BAD=1
.I '$D(^PS(54,PSOWARN)) W !,PSOWARN," does not exist in the RX CONSULT file" S BAD=1
I BAD K X
Q
FORMAT ;
N I,LEN,PTEXT
S LEN=0,PTEXT=""
F I=1:1:$L(TEXT," ") S STR=$P(TEXT," ",I)_" " D
.I LEN+$L(STR)<80 S PTEXT=PTEXT_STR,LEN=LEN+$L(STR) Q
.S LEN=0,I=I-1 D FULL Q:$G(PSSOUT) W !,PTEXT S PTEXT=""
I PTEXT'="" D FULL Q:$G(PSSOUT) W !,PTEXT S PTEXT=""
Q
;
NOTE ;
N PSSWSITE
S PSSWSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSWSITE,10)),"^",9)'="N" D
.W !,?2,"NOTE: You must edit the WARNING LABEL SOURCE field using the option"
.W !,?2,"Pharmacy System Parameters Edit to enable national warning labels."
Q
;
DEA ;
S DEA=$P($G(^PSDRUG(DRUGN,0)),"^",3)
S XX=DRUGN D WARNLST^PSSWRNA S:PSSWRN="" PSSWRN=$P($G(^PSDRUG(DRUGN,0)),"^",8)
D CHECK20^PSSWRNA,CHECKLST^PSSWRNA
Q
;
HDR ;
K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1,QUIT=1 Q
W @IOF
W "Current Warning labels for ",DRUG," (continued)"
Q
;
NOTE2 W !!,?5,"The RX CONSULT File (#54) contains local label expansions."
W !,?5,"The WARNING LABEL-ENGLISH file (#50.625) contains national label"
W !,?5,"expansions in English."
W !,?5,"The WARNING LABEL-SPANISH file (#50.626) contains national label"
W !,?5,"expansions in Spanish."
W !,?5,"It is important to note that RX Consult entry numbers do not"
W !,?5,"correlate with the other files (i.e. Number 7 in file 54 is not"
W !,?5,"included in file 50.625)."
W !!,?5,"You should print a list of the current RX CONSULT file entries"
W !,?5,"and the current WARNING LABEL-ENGLISH file entries."
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSWRNE 4934 printed Apr 09, 2024@21:36:14 Page 2
PSSWRNE ;BIR/EJW - NEW WARNING SOURCE NEW WARNING LABEL LIST EDITOR ;05/24/04
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**87,233**;9/30/97;Build 2
+2 ;
+3 ;Reference to ^PS(50.625 supported by DBIA 4445
EN(RTN) ; Entry from ^PSSLOOK PSS*1*233
+1 NEW PSSSTWN
+2 SET PSSSTWN=1
EDIT ;
+1 NEW STAR,QUIT,PSSOUT
+2 SET QUIT=0
SET STAR=""
SET PSSOUT=0
+3 SET DRUG=""
FOR
SET DRUG=$ORDER(^TMP("PSSWRNB",$JOB,DRUG))
if DRUG=""
QUIT
Begin DoDot:1
+4 SET DRUGN=$ORDER(^PSDRUG("B",DRUG,0))
if 'DRUGN
QUIT
DO DEA
DO PRINT
End DoDot:1
IF QUIT
QUIT
+5 IF $GET(PSSSTWN)
SET RTN=QUIT
+6 QUIT
+7 ;
PRINT ;
+1 NEW NEWLIST,STAR
+2 IF '$GET(PSSLOOK)
Begin DoDot:1
+3 WRITE @IOF
+4 WRITE "Current Warning labels for ",DRUG
+5 IF $GET(NEWLIST)=""
IF PSSWRN'["N"
WRITE !,"No warnings from the new data source exist for this drug."
Begin DoDot:2
+6 WRITE !,"Verify that the drug is matched to the National Drug File."
End DoDot:2
End DoDot:1
+7 IF PSSWRN'=""
Begin DoDot:1
+8 IF '$GET(PSSLOOK)
WRITE !,"Labels will print in the order in which they appear for local and CMOP fills:"
+9 IF '$GET(ENDWARN)
SET ENDWARN=5
+10 SET STAR=""
+11 FOR WWW=1:1:ENDWARN
SET PSOWARN=$PIECE(PSSWRN,",",WWW)
if PSOWARN=""
QUIT
Begin DoDot:2
+12 IF WWW>5
SET STAR="*"
+13 IF PSOWARN["N"
DO NEWWARN
QUIT
+14 DO WARN54
End DoDot:2
+15 if $GET(QUIT)
QUIT
DO FULL
if $GET(PSSOUT)
QUIT
WRITE !!,"Pharmacy fill card display: DRUG WARNING ",PSSWRN
+16 IF $GET(PSSLOOK)
QUIT
+17 IF $GET(SEL)=6
Begin DoDot:2
+18 SET WARN54=$GET(^TMP("PSSWRNB",$JOB,DRUG))
+19 DO FULL
WRITE !," RX CONSULT file Drug Warning="_WARN54
+20 NEW I,WARN
FOR I=1:1:$LENGTH(WARN54,",")
SET WARN=$PIECE(WARN54,",",I)
IF WARN'=""
IF $GET(^PS(54,WARN,2))=""
DO FULL
WRITE !," ",WARN_" "_$GET(^PS(54,WARN,0))_" is not mapped to the new data source"
End DoDot:2
+21 IF $GET(SEL)=8
Begin DoDot:2
+22 WRITE !
+23 SET DIE="^PSDRUG("
SET DA=DRUGN
SET DR=8.2
DO ^DIE
KILL DIE,DA,DR
End DoDot:2
+24 SET NEWLIST=$PIECE($GET(^PSDRUG(DRUGN,"WARN")),"^")
IF NEWLIST=""
Begin DoDot:2
+25 IF PSSWRN'["N"
QUIT
+26 DO FULL
if $GET(PSSOUT)
QUIT
WRITE !,"NOTE: Because the NEW WARNING LABEL LIST field is empty, the warnings above"
+27 DO FULL
if $GET(PSSOUT)
QUIT
WRITE !,"are the warnings that our national data source distributes for this drug."
End DoDot:2
End DoDot:1
+28 IF $GET(PSSLOOK)
QUIT
+29 IF $GET(NEWLIST)'=""
DO FULL
if $GET(PSSOUT)
QUIT
WRITE !,"NEW WARNING LABEL LIST: ",NEWLIST
+30 DO FULL
if $GET(PSSOUT)
QUIT
WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
SET DIR("A")="Would you like to edit this list of warnings"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET QUIT=1
+31 IF 'Y
Begin DoDot:1
+32 IF $GET(DRUGENT)
SET WARNEDIT=0
KILL ^TMP("PSSWRNB",$JOB)
End DoDot:1
QUIT
+33 IF $GET(DRUGENT)
SET WARNEDIT=1
KILL ^TMP("PSSWRNB",$JOB)
QUIT
+34 SET OLDWARN=PSSWRN
+35 SET DIE="^PSDRUG("
SET DA=DRUGN
SET DR=8.1
DO ^DIE
KILL DIE,DA,DR
+36 SET PSSWRN=$PIECE($GET(^PSDRUG(DRUGN,"WARN")),"^")
IF PSSWRN'=""
DO CHECK20^PSSWRNA
GOTO PRINT
+37 IF $GET(OLDWARN)'=""
IF PSSWRN=""
DO DEA
GOTO PRINT
+38 QUIT
FULL ;
+1 IF ($Y+3)>IOSL&('$GET(PSSOUT))
DO HDR
+2 QUIT
NEWWARN ;
+1 NEW PSOWRNN,JJJ,STR
+2 SET TEXT=""
+3 SET PSOWRNN=+PSOWARN
IF $DATA(^PS(50.625,PSOWRNN))
Begin DoDot:1
+4 IF '$GET(PSSLOOK)
WRITE !
+5 SET TEXT=STAR_PSOWARN_" "
+6 SET JJJ=0
FOR
SET JJJ=$ORDER(^PS(50.625,PSOWRNN,1,JJJ))
if 'JJJ
QUIT
SET STR=$GET(^PS(50.625,PSOWRNN,1,JJJ,0))
SET TEXT=TEXT_" "_STR
End DoDot:1
+7 IF TEXT'=""
DO FORMAT
IF $GET(PSSLOOK)
DO FULL^PSSLOOK
+8 QUIT
WARN54 ;
+1 SET TEXT=""
+2 IF $DATA(^PS(54,PSOWARN,1))
Begin DoDot:1
+3 IF '$GET(PSSLOOK)
WRITE !
+4 SET TEXT=STAR_PSOWARN_" "
+5 SET JJJ=0
FOR
SET JJJ=$ORDER(^PS(54,PSOWARN,1,JJJ))
if 'JJJ
QUIT
SET TEXT=TEXT_" "_$GET(^PS(54,PSOWARN,1,JJJ,0))
End DoDot:1
+6 IF TEXT'=""
DO FORMAT
IF $GET(PSSLOOK)
DO FULL^PSSLOOK
+7 QUIT
VALID ; VALIDATE NEW WARNING LABEL LIST
+1 NEW BAD
+2 SET BAD=0
+3 IF $GET(X)=""
WRITE !,"TOO MANY WARNINGS. LIMIT ANSWER STRING TO 30 CHARACTERS OR LESS"
KILL Y
QUIT
+4 FOR I=1:1:$LENGTH(X,",")
SET PSOWARN=$PIECE(X,",",I)
IF PSOWARN'=""
Begin DoDot:1
+5 IF PSOWARN["N"
SET PSOWRNN=+PSOWARN
Begin DoDot:2
+6 IF '$DATA(^PS(50.625,PSOWRNN))
WRITE !,PSOWARN," does not exist in the WARNING LABEL-ENGLISH file"
SET BAD=1
End DoDot:2
QUIT
+7 IF '$DATA(^PS(54,PSOWARN))
WRITE !,PSOWARN," does not exist in the RX CONSULT file"
SET BAD=1
End DoDot:1
+8 IF BAD
KILL X
+9 QUIT
FORMAT ;
+1 NEW I,LEN,PTEXT
+2 SET LEN=0
SET PTEXT=""
+3 FOR I=1:1:$LENGTH(TEXT," ")
SET STR=$PIECE(TEXT," ",I)_" "
Begin DoDot:1
+4 IF LEN+$LENGTH(STR)<80
SET PTEXT=PTEXT_STR
SET LEN=LEN+$LENGTH(STR)
QUIT
+5 SET LEN=0
SET I=I-1
DO FULL
if $GET(PSSOUT)
QUIT
WRITE !,PTEXT
SET PTEXT=""
End DoDot:1
+6 IF PTEXT'=""
DO FULL
if $GET(PSSOUT)
QUIT
WRITE !,PTEXT
SET PTEXT=""
+7 QUIT
+8 ;
NOTE ;
+1 NEW PSSWSITE
+2 SET PSSWSITE=+$ORDER(^PS(59.7,0))
IF $PIECE($GET(^PS(59.7,PSSWSITE,10)),"^",9)'="N"
Begin DoDot:1
+3 WRITE !,?2,"NOTE: You must edit the WARNING LABEL SOURCE field using the option"
+4 WRITE !,?2,"Pharmacy System Parameters Edit to enable national warning labels."
End DoDot:1
+5 QUIT
+6 ;
DEA ;
+1 SET DEA=$PIECE($GET(^PSDRUG(DRUGN,0)),"^",3)
+2 SET XX=DRUGN
DO WARNLST^PSSWRNA
if PSSWRN=""
SET PSSWRN=$PIECE($GET(^PSDRUG(DRUGN,0)),"^",8)
+3 DO CHECK20^PSSWRNA
DO CHECKLST^PSSWRNA
+4 QUIT
+5 ;
HDR ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSSOUT=1
SET QUIT=1
QUIT
+2 WRITE @IOF
+3 WRITE "Current Warning labels for ",DRUG," (continued)"
+4 QUIT
+5 ;
NOTE2 WRITE !!,?5,"The RX CONSULT File (#54) contains local label expansions."
+1 WRITE !,?5,"The WARNING LABEL-ENGLISH file (#50.625) contains national label"
+2 WRITE !,?5,"expansions in English."
+3 WRITE !,?5,"The WARNING LABEL-SPANISH file (#50.626) contains national label"
+4 WRITE !,?5,"expansions in Spanish."
+5 WRITE !,?5,"It is important to note that RX Consult entry numbers do not"
+6 WRITE !,?5,"correlate with the other files (i.e. Number 7 in file 54 is not"
+7 WRITE !,?5,"included in file 50.625)."
+8 WRITE !!,?5,"You should print a list of the current RX CONSULT file entries"
+9 WRITE !,?5,"and the current WARNING LABEL-ENGLISH file entries."
+10 WRITE !
+11 QUIT
