Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSWRNB

PSSWRNB.m

Go to the documentation of this file.
  1. PSSWRNB ;BIR/EJW-NEW WARNING SOURCE CUSTOM WARNING LIST BUILDER ; 9/8/05 3:46pm
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**87,98,144**;9/30/97;Build 13
  1. ;
  1. ;IA: 3735 ^PSNDF(50.68
  1. ;IA: 4445 ^PS(50.625
  1. ;IA: 4446 ^PS(50.626
  1. ;IA: 4448 ^PS(50.627
  1. D NOTE^PSSWRNE,NOTE2^PSSWRNE
  1. W ! K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")=" Would you like to print a list of the entries in these files" D ^DIR K DIR I Y["^"!($D(DTOUT)) W !!?3,"Nothing queued to print." G SEL
  1. I 'Y G SEL
  1. S SPANISH=0
  1. W ! K DIR S DIR(0)="Y",DIR("B")="N",DIR("A")=" Would you like to include the Spanish translations" D ^DIR K DIR I Y["^"!($D(DTOUT)) W !!?3,"Nothing queued to print." G SEL
  1. I Y S SPANISH=1
  1. D RPT
  1. SEL ;
  1. W @IOF
  1. D NOTE^PSSWRNE
  1. W !!,?2,"Select one of the following to display drugs that match that criteria to"
  1. W !,?2,"examine or edit their drug warnings:"
  1. K DIR
  1. S DIR("B")=""
  1. S DIR("A")="Enter selection or '^' to exit: "
  1. S DIR("A",1)="1. Drug has WARNING LABEL filled in but there are no FDB warnings for the drug"
  1. S DIR("A",2)="2. Drug has WARNING LABEL numbers higher than 20"
  1. S DIR("A",3)="3. Select by range of drug names"
  1. S DIR("A",4)="4. Drug has more than 5 warning labels"
  1. S DIR("A",5)="5. Drugs containing specific WARNING LABEL number"
  1. S DIR("A",6)="6. Drug has WARNING LABEL that does not map to new data source"
  1. S DIR("A",7)="7. Drugs containing specific new data source warning number"
  1. S DIR("A",8)="8. Drugs containing gender-specific warnings"
  1. S DIR("A",9)="9. Drugs with warning mapping, but drug doesn't contain ""mapped to"" number"
  1. S DIR(0)="SA^1:DRUGS WITH NO FDB WARNINGS;2:LOCAL WARNING (>20);3:RANGE OF DRUG NAMES;4:GREATER THAN 5 WARNINGS;5:SPECIFIC WARNING LABEL NUMBER;6:NO MAPPING;7:SPECIFIC NEW WARNING;8:GENDER-SPECIFIC WARNING;9:NO MAPPED TO"
  1. D ^DIR K DIR S SEL=Y
  1. I 'SEL G KILL
  1. N DR,ACTIVE,SKIP,QUIT,PSO9
  1. S SKIP=1,QUIT=0
  1. K ^TMP("PSSWRNB",$J)
  1. ASK K DIR W ! S DIR(0)="Y",DIR("B")="Y",DIR("A")="Exclude drugs with NEW WARNING LABEL LIST filled in" D ^DIR K DIR I Y["^"!($D(DTOUT)) G SEL
  1. I 'Y S SKIP=0
  1. W !!,$C(7),"NOTE: Only the first 5 warnings will print on the yellow auxillary labels."
  1. K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to see the warning text for all warnings" D ^DIR K DIR I Y["^"!($D(DTOUT)) G SEL
  1. S ENDWARN=5
  1. I Y S ENDWARN=99 D
  1. .W !," Warnings (>5) that won't print and won't be sent to CMOP"
  1. .W !," will be marked with a ""*"" on the following screens."
  1. W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
  1. ;
  1. I SEL=1 D SEL1^PSSWRNC
  1. ;
  1. I SEL=2 D SEL2^PSSWRNC
  1. ;
  1. I SEL=3 D SEL3^PSSWRNC
  1. ;
  1. I SEL=4 D SEL4^PSSWRNC
  1. ;
  1. I SEL=5!(SEL=9) D SEL59^PSSWRNC
  1. ;
  1. I SEL=6 D SEL6^PSSWRNC
  1. ;
  1. I SEL=7 D SEL7^PSSWRNC
  1. ;
  1. I SEL=8 D SEL8^PSSWRNC
  1. ;
  1. I 'QUIT I '$D(^TMP("PSSWRNB",$J)) W !,"Nothing meets selection criteria" H 2 S QUIT=1
  1. I 'QUIT D EDIT^PSSWRNE
  1. G SEL
  1. RPT ;
  1. RPTQ W !!,"You may queue the report to print, if you wish.",!
  1. ;
  1. DVC K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !,"Nothing queued to print.",! G DONE
  1. S ZTSAVE("*")=""
  1. I $D(IO("Q")) S ZTRTN="PRT54^PSSWRNB",ZTDESC="WARNING LABEL TEXT REPORTS" D ^%ZTLOAD K %ZIS W !,"Report queued to print.",! G DONE
  1. PRT54 ;
  1. U IO
  1. S PSSOUT=0,PSSDV=$S($E(IOST,1,2)="C-":"C",1:"P")
  1. S PSSPGCT=0,PSSPGLN=IOSL-7,PSSPGCT=1
  1. S TITLE="RX CONSULT file - WARNING LABEL TEXT"
  1. D TITLE
  1. ;
  1. S SEQ=0 F S SEQ=$O(^PS(54,SEQ)) Q:'SEQ D PRTRPT
  1. G END
  1. PRTRPT ;
  1. I $G(^PS(54,SEQ,0))'="" D RXCON D FULL I $G(PSSOUT) Q
  1. D FULL I $G(PSSOUT) Q
  1. W ! F MJT=1:1:70 W "-"
  1. Q
  1. RXCON D FULL Q:$G(PSSOUT) W !,"RX CONSULT NUMBER: ",SEQ
  1. N PSSTXT
  1. D FULL I $G(PSSOUT) Q
  1. W !
  1. S PSSTXT=0 F S PSSTXT=$O(^PS(54,SEQ,1,PSSTXT)) Q:'PSSTXT D FULL Q:$G(PSSOUT) W !,?3,^PS(54,SEQ,1,PSSTXT,0)
  1. I $G(SPANISH),$D(^PS(54,SEQ,3)) W !!,"Spanish translation:" D
  1. .S PSSTXT=^PS(54,SEQ,3) Q:PSSTXT="" D FULL Q:$G(PSSOUT) W !,?3 D
  1. ..N LEN,I,STR
  1. ..S LEN=0
  1. ..F I=1:1:$L(PSSTXT," ") S STR=$P(PSSTXT," ",I),LEN=LEN+$L(STR) W:LEN>62 !,?3 S:LEN>62 LEN=0 W STR," "
  1. Q
  1. ;
  1. FULL ;
  1. I ($Y+5)>IOSL&('$G(PSSOUT)) D TITLE
  1. Q
  1. ;
  1. TITLE ;
  1. I $E($G(PSSDV))="C",$G(PSSPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
  1. ;
  1. W @IOF
  1. W !,?16,TITLE,!
  1. S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSSPGCT,!
  1. F MJT=1:1:79 W "="
  1. W !
  1. S PSSPGCT=PSSPGCT+1
  1. Q
  1. END ;
  1. I '$G(PSSOUT),$E($G(PSSDV))="C" W !!,"End of Rx Consult file Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. I $E($G(PSSDV))="C" W !
  1. E W @IOF
  1. G PRTNEW
  1. END2 ;
  1. I '$G(PSSOUT),$E($G(PSSDV))="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. I $E($G(PSSDV))="C" W !
  1. E W @IOF
  1. DONE ;
  1. K SEQ,MJT,PSSPGCT,PSSPGLN,Y,DIR,INDT,PSSXX,X,OITM,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT
  1. K PSSDV,PSSOUT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. ;
  1. PRTNEW ;
  1. U IO
  1. S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P")
  1. S PSSPGCT=0,PSSPGLN=IOSL-7,PSSPGCT=1
  1. S TITLE="WARNING LABEL-ENGLISH file - WARNING LABEL TEXT"
  1. D TITLE
  1. ; REPORT FROM NEW WARNING LABEL SOURCE
  1. S SEQ=0 F S SEQ=$O(^PS(50.625,SEQ)) Q:'SEQ D RPTNEW
  1. G END2
  1. RPTNEW ;
  1. I $G(^PS(50.625,SEQ,0))'="" D FDBWARN D FULL I $G(PSSOUT) Q
  1. D FULL I $G(PSSOUT) Q
  1. W ! F MJT=1:1:70 W "-"
  1. Q
  1. FDBWARN D FULL Q:$G(PSSOUT) W !,"WARNING LABEL-ENGLISH NUMBER: ",+SEQ
  1. N PSSTXT
  1. D FULL I $G(PSSOUT) Q
  1. W !
  1. S PSSTXT=0 F S PSSTXT=$O(^PS(50.625,SEQ,1,PSSTXT)) Q:'PSSTXT D FULL Q:$G(PSSOUT) W !,?3,^PS(50.625,SEQ,1,PSSTXT,0)
  1. I $G(SPANISH) W !!,"Spanish translation:" D
  1. .S PSSTXT=0 F S PSSTXT=$O(^PS(50.626,SEQ,1,PSSTXT)) Q:'PSSTXT D FULL Q:$G(PSSOUT) W !,?3,^PS(50.626,SEQ,1,PSSTXT,0)
  1. Q
  1. ;
  1. KILL ;
  1. K ^TMP("PSSWRNB",$J),NDF,PSSWRN,SEL,SPANISH,WARN54,RXNUM,WARN,WARN20,STR,PSOWARN,JJJ,TEXT,WWW,DRUGN,DRUG,DEA,TITLE
  1. Q
  1. DRUG ;
  1. S NDF=0
  1. N PSOPROD,GCNSEQNO,I,NEWWARN
  1. S PSSWRN=""
  1. S PSOPROD=$P($G(^PSDRUG(DR,"ND")),"^",3) I PSOPROD="" Q
  1. S NDF=1
  1. S GCNSEQNO=$$GET1^DIQ(50.68,PSOPROD,11,"I")
  1. I GCNSEQNO="" Q
  1. D GCN^PSSWRNA
  1. Q
  1. WARN ; ENTRY POINT DRUG ENTER/EDIT OPTION
  1. S DRUGENT=1
  1. S DRUG=$P($G(^PSDRUG(DA,0)),"^") I DRUG="" Q
  1. S ^TMP("PSSWRNB",$J,DRUG)=""
  1. D EDIT^PSSWRNE
  1. Q
  1. ACTIVE ;
  1. S ACTIVE=1
  1. I $P($G(^PSDRUG(DR,"I")),"^"),$P($G(^("I")),"^")<DT S ACTIVE=0 Q
  1. Q