PSSWRNE.m

PSSWRNE ;BIR/EJW-NEW WARNING SOURCE NEW WARNING LABEL LIST EDITOR ;05/24/04

 ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97

 ;

 ;Reference to ^PS(50.625 supported by DBIA 4445

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

 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

 .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

PSSWRNE   ;BIR/EJW-NEW WARNING SOURCE NEW WARNING LABEL LIST EDITOR ;05/24/04

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97

 +2       ;

 +3       ;Reference to ^PS(50.625 supported by DBIA 4445

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        QUIT 

 +6       ;

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               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