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

PSSWRNC.m

Go to the documentation of this file.
  1. PSSWRNC ;DAL/RJS-NEW WARNING SOURCE CUSTOM WARNING LIST BUILDER CONT;
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**98,144**;10/12/05;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. SEL1 ;
  1. S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
  1. .I '$D(^PSDRUG(DR,0)) Q
  1. .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .D DRUG^PSSWRNB I PSSWRN="" S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54_"^"_NDF
  1. Q
  1. SEL2 ;
  1. S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
  1. .I '$D(^PSDRUG(DR,0)) Q
  1. .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .F I=1:1:$L(WARN54,",") S WARN=$P(WARN54,",",I) I WARN>20 D
  1. ..I '$D(^PS(54,WARN)) Q
  1. ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54
  1. Q
  1. SEL3 ;; >> BEGIN *144 - RJS
  1. 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
  1. S PSSDRG=$P(Y,"^",2),PSSDG(PSSDRG)=1
  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
  1. S PSSEDRG=$P(Y,"^",2),PSSDG(PSSEDRG)=2 K Y
  1. S PSS1="",PSS1=$O(PSSDG(PSS1)) I $G(PSSDG(PSS1))>1 D G SEL3 ;;<<END *144 - RJS
  1. .W !!,?10,"The Ending drug name must come alphabetically",!,?16,"after your Starting drug name.",! H 2
  1. .K PSSDG
  1. W !!,"WARNINGS FOR DRUGS FROM "_PSSDRG_" TO "_PSSEDRG
  1. W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1,QUIT=1 Q
  1. I $D(^PSDRUG("B",PSSDRG)) S I=$L(PSSDRG),PSSDRG=$E(PSSDRG,1,I-1)
  1. F S PSSDRG=$O(^PSDRUG("B",PSSDRG)) Q:PSSDRG="" Q:PSSDRG]PSSEDRG D
  1. .S DR=$O(^PSDRUG("B",PSSDRG,0)) I DR="" Q
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .S ^TMP("PSSWRNB",$J,PSSDRG)=""
  1. K PSSDG,PSSDRG,PSSEDRG,PSS1 ;; CLEANUP << *144 - RJS
  1. Q
  1. SEL4 ;
  1. S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .D DRUG^PSSWRNB I PSSWRN="" Q
  1. .N XX S XX=DR D CHECK20^PSSWRNA
  1. .I $L(PSSWRN,",")>5 S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=PSSWRN
  1. Q
  1. SEL59 ;
  1. S DIC=54,DIC(0)="AEQM",DIC("A")="Select drugs containing RX Consult number:" D ^DIC K DIC I Y<0 Q
  1. S RXNUM=$P(Y,"^")
  1. 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
  1. 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
  1. I SEL=9 S PSO9=$G(^PS(54,RXNUM,2))_"N" W " ",RXNUM," is mapped to ",PSO9 H 1
  1. S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
  1. .I '$D(^PSDRUG(DR,0)) Q
  1. .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .I ","_WARN54_","[(","_RXNUM_",") D
  1. ..I SEL=9 D DRUG^PSSWRNB I PSSWRN="" Q
  1. ..I SEL=9,","_PSSWRN_","[(","_PSO9_",") Q
  1. ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54
  1. Q
  1. SEL6 ;
  1. S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
  1. .I '$D(^PSDRUG(DR,0)) Q
  1. .S WARN54=$P(^PSDRUG(DR,0),"^",8) I WARN54="" Q
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .F I=1:1:$L(WARN54,",") S WARN=$P(WARN54,",",I) I WARN,$D(^PS(54,WARN,1)),$G(^PS(54,WARN,2))="" D
  1. ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=WARN54
  1. Q
  1. SEL7 ;
  1. W !! K DIR S DIR("A")="Select drugs containing New warning number"
  1. S DIR("?",1)="Answer with WARNING LABEL-ENGLISH NUMBER using the format #N." ;;<<BEGIN *144 - RJS
  1. S DIR("?",2)="Where # is the numeric number of the warning label desired."
  1. S DIR("?")="Example: for the warning label number 15 entry 15N." ;; << END *144 - RJS
  1. S DIR("??")="^D HELP^PSSWRNC"
  1. S DIR(0)="FO"
  1. D ^DIR S RXNUM=Y
  1. 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
  1. I RXNUM["N"!(RXNUM["n") S RXNUM=$TR(RXNUM,"Nn","")
  1. I RXNUM="^"!(RXNUM="")!(RXNUM=" ") S QUIT=1 Q
  1. I '$D(^PS(50.625,RXNUM)) W !,$C(7),?5,RXNUM_" is not in the New warning file" H 2 S QUIT=1 Q
  1. W @IOF
  1. W "Searching for drugs that contain new warning number "_RXNUM
  1. S PSOWARN=RXNUM_"N",STAR="" D NEWWARN^PSSWRNE
  1. K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1 Q
  1. S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .D DRUG^PSSWRNB I PSSWRN="" Q
  1. .I ","_PSSWRN_","[(","_RXNUM_"N,") S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=PSSWRN
  1. Q
  1. SEL8 ;
  1. N WARN,GEND
  1. S WARN=0 F S WARN=$O(^PS(50.625,WARN)) Q:'WARN I $G(^PS(50.625,WARN,2))'="" S GEND(WARN_"N")=""
  1. I $O(GEND(""))="" Q
  1. S DR=0 F S DR=$O(^PSDRUG(DR)) Q:'DR D
  1. .I SKIP,$P($G(^PSDRUG(DR,"WARN")),"^")'="" Q
  1. .D ACTIVE^PSSWRNB I 'ACTIVE Q
  1. .D DRUG^PSSWRNB I PSSWRN="" Q
  1. .S WARN=0 F S WARN=$O(GEND(WARN)) Q:'WARN I ","_PSSWRN_","[(","_WARN_",") D
  1. ..S ^TMP("PSSWRNB",$J,$P(^PSDRUG(DR,0),"^"))=PSSWRN
  1. Q
  1. HELP ; WARNING LABEL-ENGLISH NUMBER DISPLAY LOGIC *144 - RJS
  1. N DIR,DIRUT,DUOUT,PSSCNTR,PSSIEN,PSSEND,X,Y
  1. W #,!,"Select drugs containing New warning number:",!!,?4,"Choose from:",!
  1. S (PSSCNTR,PSSIEN,PSSEND)=0,DIR(0)="FO",DIR("A")=" '^' to STOP"
  1. F S PSSIEN=$O(^PS(50.625,PSSIEN)) Q:'PSSIEN!(PSSEND="^") D
  1. .S PSSCNT=$P(^PS(50.625,PSSIEN,1,0),"^",4)
  1. .I PSSCNTR+PSSCNT>17 D EOP Q:PSSEND="^"
  1. .W !,?4,PSSIEN,"N"
  1. .F PSSCT=1:1:PSSCNT W:PSSCT>1 ! W ?12,$G(^PS(50.625,PSSIEN,1,PSSCT,0))
  1. .S PSSCNTR=PSSCNTR+PSSCNT
  1. K PSSCNT,PSSCT
  1. Q
  1. EOP ; END OF PAGE LOGIC *144 - RJS
  1. D ^DIR
  1. I $G(X)!(Y="^") S PSSEND="^" Q
  1. W #,!,"Select drugs containing New warning number:",!!,?4,"Choose from:",!
  1. S PSSCNTR=0
  1. Q