- PSSWRNC ;DAL/RJS-NEW WARNING SOURCE CUSTOM WARNING LIST BUILDER CONT;
- ;;1.0;PHARMACY DATA MANAGEMENT;**98,144**;10/12/05;Build 13
- ;
- ;IA: 3735 ^PSNDF(50.68
- ;IA: 4445 ^PS(50.625
- ;IA: 4446 ^PS(50.626
- ;IA: 4448 ^PS(50.627
- SEL1 ;
- S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
- .I '$D(^PSDRUG(DR,0)) Q
- .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .D DRUG^PSSWRNB I PSSWRN="" S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54_"^"_NDF
- Q
- SEL2 ;
- S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
- .I '$D(^PSDRUG(DR,0)) Q
- .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .F I=1:1:$L(WARN54,",") S WARN=$P(WARN54,",",I) I WARN>20 D
- ..I '$D(^PS(54,WARN)) Q
- ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54
- Q
- SEL3 ;; >> BEGIN *144 - RJS
- W ! K DIC S DIC("B")="",DIC="^PSDRUG(",DIC(0)="AEKQM",DIC("A")="Enter starting drug name: " D ^DIC K DIC I Y=-1 S QUIT=1 Q
- S PSSDRG=$P(Y,"^",2),PSSDG(PSSDRG)=1
- W ! K Y S DIC("B")="",DIC="^PSDRUG(",DIC(0)="AEKQM",DIC("A")="Enter ending drug name: " D ^DIC K DIC I Y=-1 S QUIT=1 Q
- S PSSEDRG=$P(Y,"^",2),PSSDG(PSSEDRG)=2 K Y
- S PSS1="",PSS1=$O(PSSDG(PSS1)) I $G(PSSDG(PSS1))>1 D G SEL3 ;;<<END *144 - RJS
- .W !!,?10,"The Ending drug name must come alphabetically",!,?16,"after your Starting drug name.",! H 2
- .K PSSDG
- W !!,"WARNINGS FOR DRUGS FROM "_PSSDRG_" TO "_PSSEDRG
- W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1,QUIT=1 Q
- I $D(^PSDRUG("B",PSSDRG)) S I=$L(PSSDRG),PSSDRG=$E(PSSDRG,1,I-1)
- F S PSSDRG=$O(^PSDRUG("B",PSSDRG)) Q:PSSDRG="" Q:PSSDRG]PSSEDRG D
- .S DR=$O(^PSDRUG("B",PSSDRG,0)) I DR="" Q
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .S ^TMP("PSSWRNB",$J,PSSDRG)=""
- K PSSDG,PSSDRG,PSSEDRG,PSS1 ;; CLEANUP << *144 - RJS
- Q
- SEL4 ;
- S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .D DRUG^PSSWRNB I PSSWRN="" Q
- .N XX S XX=DR D CHECK20^PSSWRNA
- .I $L(PSSWRN,",")>5 S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=PSSWRN
- Q
- SEL59 ;
- S DIC=54,DIC(0)="AEQM",DIC("A")="Select drugs containing RX Consult number:" D ^DIC K DIC I Y<0 Q
- S RXNUM=$P(Y,"^")
- I '$D(^PS(54,RXNUM)) W !,RXNUM_" is not in the RX Consult file.",! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
- I SEL=9,'$G(^PS(54,RXNUM,2)) W !,RXNUM," is not mapped to a new data source warning",! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
- I SEL=9 S PSO9=$G(^PS(54,RXNUM,2))_"N" W " ",RXNUM," is mapped to ",PSO9 H 1
- S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
- .I '$D(^PSDRUG(DR,0)) Q
- .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .I ","_WARN54_","[(","_RXNUM_",") D
- ..I SEL=9 D DRUG^PSSWRNB I PSSWRN="" Q
- ..I SEL=9,","_PSSWRN_","[(","_PSO9_",") Q
- ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54
- Q
- SEL6 ;
- S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
- .I '$D(^PSDRUG(DR,0)) Q
- .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .F I=1:1:$L(WARN54,",") S WARN=$P(WARN54,",",I) I WARN,$D(^PS(54,WARN,1)),$G(^PS(54,WARN,2))="" D
- ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54
- Q
- SEL7 ;
- W !! K DIR S DIR("A")="Select drugs containing New warning number"
- S DIR("?",1)="Answer with WARNING LABEL-ENGLISH NUMBER using the format #N." ;;<<BEGIN *144 - RJS
- S DIR("?",2)="Where # is the numeric number of the warning label desired."
- S DIR("?")="Example: for the warning label number 15 entry 15N." ;; << END *144 - RJS
- S DIR("??")="^D HELP^PSSWRNC"
- S DIR(0)="FO"
- D ^DIR S RXNUM=Y
- I Y="N"!(Y="n")!(Y="Y")!(Y="y") W !,$C(7),?5,RXNUM_" is not a valid entry" H 2 S QUIT=1 Q
- I RXNUM["N"!(RXNUM["n") S RXNUM=$TR(RXNUM,"Nn","")
- I RXNUM="^"!(RXNUM="")!(RXNUM=" ") S QUIT=1 Q
- I '$D(^PS(50.625,RXNUM)) W !,$C(7),?5,RXNUM_" is not in the New warning file" H 2 S QUIT=1 Q
- W @IOF
- W "Searching for drugs that contain new warning number "_RXNUM
- S PSOWARN=RXNUM_"N",STAR="" D NEWWARN^PSSWRNE
- K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
- S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .D DRUG^PSSWRNB I PSSWRN="" Q
- .I ","_PSSWRN_","[(","_RXNUM_"N,") S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=PSSWRN
- Q
- SEL8 ;
- N WARN,GEND
- S WARN=0 F S WARN=$O(^PS(50.625,WARN)) Q:'WARN I $G(^PS(50.625,WARN,2))'="" S GEND(WARN_"N")=""
- I $O(GEND(""))="" Q
- S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
- .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
- .D ACTIVE^PSSWRNB I 'ACTIVE Q
- .D DRUG^PSSWRNB I PSSWRN="" Q
- .S WARN=0 F S WARN=$O(GEND(WARN)) Q:'WARN I ","_PSSWRN_","[(","_WARN_",") D
- ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=PSSWRN
- Q
- HELP ; WARNING LABEL-ENGLISH NUMBER DISPLAY LOGIC *144 - RJS
- N DIR,DIRUT,DUOUT,PSSCNTR,PSSIEN,PSSEND,X,Y
- W #,!,"Select drugs containing New warning number:",!!,?4,"Choose from:",!
- S (PSSCNTR,PSSIEN,PSSEND)=0,DIR(0)="FO",DIR("A")=" '^' to STOP"
- F S PSSIEN=$O(^PS(50.625,PSSIEN)) Q:'PSSIEN!(PSSEND="^") D
- .S PSSCNT=$P(^PS(50.625,PSSIEN,1,0),"^",4)
- .I PSSCNTR+PSSCNT>17 D EOP Q:PSSEND="^"
- .W !,?4,PSSIEN,"N"
- .F PSSCT=1:1:PSSCNT W:PSSCT>1 ! W ?12,$G(^PS(50.625,PSSIEN,1,PSSCT,0))
- .S PSSCNTR=PSSCNTR+PSSCNT
- K PSSCNT,PSSCT
- Q
- EOP ; END OF PAGE LOGIC *144 - RJS
- D ^DIR
- I $G(X)!(Y="^") S PSSEND="^" Q
- W #,!,"Select drugs containing New warning number:",!!,?4,"Choose from:",!
- S PSSCNTR=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSWRNC 5664 printed Jan 18, 2025@03:35:32 Page 2
- PSSWRNC ;DAL/RJS-NEW WARNING SOURCE CUSTOM WARNING LIST BUILDER CONT;
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**98,144**;10/12/05;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
- SEL1 ;
- +1 SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG(DR))
- if 'DR
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^PSDRUG(DR,0))
- QUIT
- +3 SET WARN54=$PIECE(^PSDRUG(DR,0),"^",8)
- IF WARN54=""
- QUIT
- +4 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +5 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +6 DO DRUG^PSSWRNB
- IF PSSWRN=""
- SET ^TMP("PSSWRNB",$JOB,$PIECE(^PSDRUG(DR,0),"^"))=WARN54_"^"_NDF
- End DoDot:1
- +7 QUIT
- SEL2 ;
- +1 SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG(DR))
- if 'DR
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^PSDRUG(DR,0))
- QUIT
- +3 SET WARN54=$PIECE(^PSDRUG(DR,0),"^",8)
- IF WARN54=""
- QUIT
- +4 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +5 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +6 FOR I=1:1:$LENGTH(WARN54,",")
- SET WARN=$PIECE(WARN54,",",I)
- IF WARN>20
- Begin DoDot:2
- +7 IF '$DATA(^PS(54,WARN))
- QUIT
- +8 SET ^TMP("PSSWRNB",$JOB,$PIECE(^PSDRUG(DR,0),"^"))=WARN54
- End DoDot:2
- End DoDot:1
- +9 QUIT
- SEL3 ;; >> BEGIN *144 - RJS
- +1 WRITE !
- KILL DIC
- SET DIC("B")=""
- SET DIC="^PSDRUG("
- SET DIC(0)="AEKQM"
- SET DIC("A")="Enter starting drug name: "
- DO ^DIC
- KILL DIC
- IF Y=-1
- SET QUIT=1
- QUIT
- +2 SET PSSDRG=$PIECE(Y,"^",2)
- SET PSSDG(PSSDRG)=1
- +3 WRITE !
- KILL Y
- SET DIC("B")=""
- SET DIC="^PSDRUG("
- SET DIC(0)="AEKQM"
- SET DIC("A")="Enter ending drug name: "
- DO ^DIC
- KILL DIC
- IF Y=-1
- SET QUIT=1
- QUIT
- +4 SET PSSEDRG=$PIECE(Y,"^",2)
- SET PSSDG(PSSEDRG)=2
- KILL Y
- +5 ;;<<END *144 - RJS
- SET PSS1=""
- SET PSS1=$ORDER(PSSDG(PSS1))
- IF $GET(PSSDG(PSS1))>1
- Begin DoDot:1
- +6 WRITE !!,?10,"The Ending drug name must come alphabetically",!,?16,"after your Starting drug name.",!
- HANG 2
- +7 KILL PSSDG
- End DoDot:1
- GOTO SEL3
- +8 WRITE !!,"WARNINGS FOR DRUGS FROM "_PSSDRG_" TO "_PSSEDRG
- +9 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSSOUT=1
- SET QUIT=1
- QUIT
- +10 IF $DATA(^PSDRUG("B",PSSDRG))
- SET I=$LENGTH(PSSDRG)
- SET PSSDRG=$EXTRACT(PSSDRG,1,I-1)
- +11 FOR
- SET PSSDRG=$ORDER(^PSDRUG("B",PSSDRG))
- if PSSDRG=""
- QUIT
- if PSSDRG]PSSEDRG
- QUIT
- Begin DoDot:1
- +12 SET DR=$ORDER(^PSDRUG("B",PSSDRG,0))
- IF DR=""
- QUIT
- +13 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +14 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +15 SET ^TMP("PSSWRNB",$JOB,PSSDRG)=""
- End DoDot:1
- +16 ;; CLEANUP << *144 - RJS
- KILL PSSDG,PSSDRG,PSSEDRG,PSS1
- +17 QUIT
- SEL4 ;
- +1 SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG(DR))
- if 'DR
- QUIT
- Begin DoDot:1
- +2 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +3 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +4 DO DRUG^PSSWRNB
- IF PSSWRN=""
- QUIT
- +5 NEW XX
- SET XX=DR
- DO CHECK20^PSSWRNA
- +6 IF $LENGTH(PSSWRN,",")>5
- SET ^TMP("PSSWRNB",$JOB,$PIECE(^PSDRUG(DR,0),"^"))=PSSWRN
- End DoDot:1
- +7 QUIT
- SEL59 ;
- +1 SET DIC=54
- SET DIC(0)="AEQM"
- SET DIC("A")="Select drugs containing RX Consult number:"
- DO ^DIC
- KILL DIC
- IF Y<0
- QUIT
- +2 SET RXNUM=$PIECE(Y,"^")
- +3 IF '$DATA(^PS(54,RXNUM))
- WRITE !,RXNUM_" is not in the RX Consult file.",!
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSSOUT=1
- QUIT
- +4 IF SEL=9
- IF '$GET(^PS(54,RXNUM,2))
- WRITE !,RXNUM," is not mapped to a new data source warning",!
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSSOUT=1
- QUIT
- +5 IF SEL=9
- SET PSO9=$GET(^PS(54,RXNUM,2))_"N"
- WRITE " ",RXNUM," is mapped to ",PSO9
- HANG 1
- +6 SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG(DR))
- if 'DR
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(^PSDRUG(DR,0))
- QUIT
- +8 SET WARN54=$PIECE(^PSDRUG(DR,0),"^",8)
- IF WARN54=""
- QUIT
- +9 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +10 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +11 IF ","_WARN54_","[(","_RXNUM_",")
- Begin DoDot:2
- +12 IF SEL=9
- DO DRUG^PSSWRNB
- IF PSSWRN=""
- QUIT
- +13 IF SEL=9
- IF ","_PSSWRN_","[(","_PSO9_",")
- QUIT
- +14 SET ^TMP("PSSWRNB",$JOB,$PIECE(^PSDRUG(DR,0),"^"))=WARN54
- End DoDot:2
- End DoDot:1
- +15 QUIT
- SEL6 ;
- +1 SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG(DR))
- if 'DR
- QUIT
- Begin DoDot:1
- +2 IF '$DATA(^PSDRUG(DR,0))
- QUIT
- +3 SET WARN54=$PIECE(^PSDRUG(DR,0),"^",8)
- IF WARN54=""
- QUIT
- +4 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +5 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +6 FOR I=1:1:$LENGTH(WARN54,",")
- SET WARN=$PIECE(WARN54,",",I)
- IF WARN
- IF $DATA(^PS(54,WARN,1))
- IF $GET(^PS(54,WARN,2))=""
- Begin DoDot:2
- +7 SET ^TMP("PSSWRNB",$JOB,$PIECE(^PSDRUG(DR,0),"^"))=WARN54
- End DoDot:2
- End DoDot:1
- +8 QUIT
- SEL7 ;
- +1 WRITE !!
- KILL DIR
- SET DIR("A")="Select drugs containing New warning number"
- +2 ;;<<BEGIN *144 - RJS
- SET DIR("?",1)="Answer with WARNING LABEL-ENGLISH NUMBER using the format #N."
- +3 SET DIR("?",2)="Where # is the numeric number of the warning label desired."
- +4 ;; << END *144 - RJS
- SET DIR("?")="Example: for the warning label number 15 entry 15N."
- +5 SET DIR("??")="^D HELP^PSSWRNC"
- +6 SET DIR(0)="FO"
- +7 DO ^DIR
- SET RXNUM=Y
- +8 IF Y="N"!(Y="n")!(Y="Y")!(Y="y")
- WRITE !,$CHAR(7),?5,RXNUM_" is not a valid entry"
- HANG 2
- SET QUIT=1
- QUIT
- +9 IF RXNUM["N"!(RXNUM["n")
- SET RXNUM=$TRANSLATE(RXNUM,"Nn","")
- +10 IF RXNUM="^"!(RXNUM="")!(RXNUM=" ")
- SET QUIT=1
- QUIT
- +11 IF '$DATA(^PS(50.625,RXNUM))
- WRITE !,$CHAR(7),?5,RXNUM_" is not in the New warning file"
- HANG 2
- SET QUIT=1
- QUIT
- +12 WRITE @IOF
- +13 WRITE "Searching for drugs that contain new warning number "_RXNUM
- +14 SET PSOWARN=RXNUM_"N"
- SET STAR=""
- DO NEWWARN^PSSWRNE
- +15 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSSOUT=1
- QUIT
- +16 SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG(DR))
- if 'DR
- QUIT
- Begin DoDot:1
- +17 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +18 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +19 DO DRUG^PSSWRNB
- IF PSSWRN=""
- QUIT
- +20 IF ","_PSSWRN_","[(","_RXNUM_"N,")
- SET ^TMP("PSSWRNB",$JOB,$PIECE(^PSDRUG(DR,0),"^"))=PSSWRN
- End DoDot:1
- +21 QUIT
- SEL8 ;
- +1 NEW WARN,GEND
- +2 SET WARN=0
- FOR
- SET WARN=$ORDER(^PS(50.625,WARN))
- if 'WARN
- QUIT
- IF $GET(^PS(50.625,WARN,2))'=""
- SET GEND(WARN_"N")=""
- +3 IF $ORDER(GEND(""))=""
- QUIT
- +4 SET DR=0
- FOR
- SET DR=$ORDER(^PSDRUG(DR))
- if 'DR
- QUIT
- Begin DoDot:1
- +5 IF SKIP
- IF $PIECE($GET(^PSDRUG(DR,"WARN")),"^")'=""
- QUIT
- +6 DO ACTIVE^PSSWRNB
- IF 'ACTIVE
- QUIT
- +7 DO DRUG^PSSWRNB
- IF PSSWRN=""
- QUIT
- +8 SET WARN=0
- FOR
- SET WARN=$ORDER(GEND(WARN))
- if 'WARN
- QUIT
- IF ","_PSSWRN_","[(","_WARN_",")
- Begin DoDot:2
- +9 SET ^TMP("PSSWRNB",$JOB,$PIECE(^PSDRUG(DR,0),"^"))=PSSWRN
- End DoDot:2
- End DoDot:1
- +10 QUIT
- HELP ; WARNING LABEL-ENGLISH NUMBER DISPLAY LOGIC *144 - RJS
- +1 NEW DIR,DIRUT,DUOUT,PSSCNTR,PSSIEN,PSSEND,X,Y
- +2 WRITE #,!,"Select drugs containing New warning number:",!!,?4,"Choose from:",!
- +3 SET (PSSCNTR,PSSIEN,PSSEND)=0
- SET DIR(0)="FO"
- SET DIR("A")=" '^' to STOP"
- +4 FOR
- SET PSSIEN=$ORDER(^PS(50.625,PSSIEN))
- if 'PSSIEN!(PSSEND="^")
- QUIT
- Begin DoDot:1
- +5 SET PSSCNT=$PIECE(^PS(50.625,PSSIEN,1,0),"^",4)
- +6 IF PSSCNTR+PSSCNT>17
- DO EOP
- if PSSEND="^"
- QUIT
- +7 WRITE !,?4,PSSIEN,"N"
- +8 FOR PSSCT=1:1:PSSCNT
- if PSSCT>1
- WRITE !
- WRITE ?12,$GET(^PS(50.625,PSSIEN,1,PSSCT,0))
- +9 SET PSSCNTR=PSSCNTR+PSSCNT
- End DoDot:1
- +10 KILL PSSCNT,PSSCT
- +11 QUIT
- EOP ; END OF PAGE LOGIC *144 - RJS
- +1 DO ^DIR
- +2 IF $GET(X)!(Y="^")
- SET PSSEND="^"
- QUIT
- +3 WRITE #,!,"Select drugs containing New warning number:",!!,?4,"Choose from:",!
- +4 SET PSSCNTR=0
- +5 QUIT