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