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

PSSUTIL.m

Go to the documentation of this file.
  1. PSSUTIL ;BIR/RTR-utility routine for NDF changes ;04/04/00
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**34,38,147,155,170,243,226**;9/30/97;Build 10
  1. ;
  1. ;Reference to PS(50.607 supported by DBIA 2221
  1. ;
  1. ;*226- create Hazardous Handle & Dispose API for Drugs/Orderable Items; and Haz Warning text for dialogs in Backdoor
  1. ;
  1. EN(PSSDIEN) ;Receive Drug entries unmatched as a result of NDF changes
  1. ;Not called, NDF deletes the possible and local possible dosages
  1. Q
  1. EN1(PSSDIEN,PSSTALK) ;Receive Drug entries that have been unmatched
  1. N PSSLD,PSSLOCV,PSSPWXEX
  1. S PSSLOCV=$O(^PS(59.7,0))
  1. ;I $P($G(^PS(59.7,+$G(PSSLOCV),80)),"^",3)<2 Q
  1. W !!,"Deleting Possible Dosages.."
  1. K ^PSDRUG(PSSDIEN,"DOS"),^PSDRUG(PSSDIEN,"DOS1")
  1. H 1 W "."
  1. I '$G(PSSTALK) K ^PSDRUG(PSSDIEN,"DOS2") G EQ
  1. I '$O(^PSDRUG(PSSDIEN,"DOS2",0)) W !
  1. I $O(^PSDRUG(PSSDIEN,"DOS2",0)) D DASK D W ! K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Delete these Local Possible Dosages" D ^DIR K DIR I Y=1 W !!,"Deleting Local Possible Dosages.." K ^PSDRUG(PSSDIEN,"DOS2") H 1 W "." W ! G EQ
  1. .S PSSPWXEX=0 W !!,"LOCAL POSSIBLE DOSAGES:"
  1. .W ! F PSSLD=0:0 S PSSLD=$O(^PSDRUG(PSSDIEN,"DOS2",PSSLD)) Q:'PSSLD!(PSSPWXEX) D
  1. ..D:($Y+5)>IOSL ZASK Q:PSSPWXEX W !,$P($G(^PSDRUG(PSSDIEN,"DOS2",PSSLD,0)),"^")_" "_$S($P($G(^(0)),"^",2)="":"(No package)",1:"(Package -> "_$P($G(^(0)),"^",2)_")") D DOSEADD
  1. I $O(^PSDRUG(PSSDIEN,"DOS2",0)) W !!,"Local Possible Dosages not deleted.",!
  1. EQ Q
  1. EN2(PSSDIEN,PSSTALK) ;Receive Drug entries matched to NDF
  1. ;Do we need entry point on an Orderable Item match (not matched to NDF)
  1. Q:'$D(^PSDRUG(PSSDIEN,0))
  1. K ^PSDRUG(PSSDIEN,"DOS"),^PSDRUG(PSSDIEN,"DOS1")
  1. N PSSUPRA,PSSLOC,PSSO,PSSI,PSSND,PSSND1,PSSBOTH,PSSONLYI,PSSONLYO,PSSNODE,PSSDF,PSSST,PSSUN,PSSTOT,PSSTOTX,PSSDUPD,PSSTODOS,PSSFLAG
  1. S PSSLOC=$O(^PS(59.7,0))
  1. ;I $P($G(^PS(59.7,+$G(PSSLOC),80)),"^",3)<3 Q
  1. S PSSBOTH=1
  1. S (PSSONLYI,PSSONLYO,PSSFLAG)=0,PSSUPRA=""
  1. S PSSND=$P($G(^PSDRUG(PSSDIEN,"ND")),"^",3),PSSND1=$P($G(^("ND")),"^") I 'PSSND!('PSSND1) G LOC
  1. S PSSNODE=$$DFSU^PSNAPIS(PSSND1,PSSND) S PSSDF=$P(PSSNODE,"^"),PSSST=$P(PSSNODE,"^",4),PSSUN=$P(PSSNODE,"^",5)
  1. S PSSUPRA=$$SUPRA^PSSUTIL3(PSSND)
  1. I $G(PSSTALK) W !!,"Resetting Possible Dosages..",! D K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. .I PSSUPRA="NO",$G(PSSXYZ)=1 W !,"Due to National Drug File settings only ONE possible dosage was auto-created.",!,"If other dosages are needed, create POSSIBLE DOSAGES or LOCAL POSSIBLE ",!,"DOSAGES as appropriate.",!
  1. .I PSSUPRA="NB",$G(PSSXYZ)=1 W !,"Due to National Drug File settings TWO possible dosages were auto-created.",!
  1. I 'PSSDF!('PSSUN)!($G(PSSST)="") G LOC
  1. I '$D(^PS(50.606,PSSDF,0))!('$D(^PS(50.607,PSSUN,0))) G LOC
  1. I PSSST'?.N&(PSSST'?.N1".".N) G LOC
  1. S (PSSI,PSSO)=0
  1. I $D(^PS(50.606,"ACONI",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPI",PSSDF,0)) S PSSI=1
  1. I $D(^PS(50.606,"ACONO",PSSDF,PSSUN)),$O(^PS(50.606,"ADUPO",PSSDF,0)) S PSSO=1
  1. I 'PSSO,'PSSI G LOC
  1. I PSSUPRA="NN" S ^PSDRUG(PSSDIEN,"DOS")=PSSST_"^"_PSSUN Q
  1. I PSSUPRA="NO"!(PSSUPRA="NB") G EN2^PSSUTIL3
  1. I PSSI,'PSSO D S:PSSTOT>1 PSSTOTX=PSSTOT-1,^PSDRUG(PSSDIEN,"DOS")=PSSST_"^"_PSSUN,PSSONLYO=1,PSSBOTH=0,^PSDRUG(PSSDIEN,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX) G LOC
  1. .S PSSTOT=1 F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
  1. ..S PSSTODOS=PSSDUPD*PSSST
  1. ..S ^PSDRUG(PSSDIEN,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^I",^PSDRUG(PSSDIEN,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
  1. I PSSO,'PSSI D S:PSSTOT>1 PSSTOTX=PSSTOT-1,^PSDRUG(PSSDIEN,"DOS")=PSSST_"^"_PSSUN,PSSONLYI=1,PSSBOTH=0,^PSDRUG(PSSDIEN,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX) G LOC
  1. .S PSSTOT=1 F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
  1. ..S PSSTODOS=PSSDUPD*PSSST
  1. ..S ^PSDRUG(PSSDIEN,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSDIEN,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
  1. I PSSO,PSSI D S:PSSTOT>1 PSSTOTX=PSSTOT-1,PSSFLAG=1,^PSDRUG(PSSDIEN,"DOS")=PSSST_"^"_PSSUN,^PSDRUG(PSSDIEN,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX)
  1. .S PSSTOT=1 F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q:'PSSDUPD D
  1. ..S PSSTODOS=PSSDUPD*PSSST
  1. ..S ^PSDRUG(PSSDIEN,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS S $P(^PSDRUG(PSSDIEN,"DOS1",PSSTOT,0),"^",3)=$S($D(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)):"IO",1:"I") S ^PSDRUG(PSSDIEN,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
  1. I PSSO,PSSI D S:PSSTOT>1 PSSTOTX=PSSTOT-1,PSSFLAG=1,^PSDRUG(PSSDIEN,"DOS")=PSSST_"^"_PSSUN,^PSDRUG(PSSDIEN,"DOS1",0)="^50.0903^"_$G(PSSTOTX)_"^"_$G(PSSTOTX)
  1. .F PSSDUPD=0:0 S PSSDUPD=$O(^PS(50.606,"ADUPO",PSSDF,PSSDUPD)) Q:'PSSDUPD D
  1. ..I $D(^PS(50.606,"ADUPI",PSSDF,PSSDUPD)) Q
  1. ..S PSSTODOS=PSSDUPD*PSSST
  1. ..S ^PSDRUG(PSSDIEN,"DOS1",PSSTOT,0)=PSSDUPD_"^"_PSSTODOS_"^O",^PSDRUG(PSSDIEN,"DOS1","B",PSSDUPD,PSSTOT)="" S PSSTOT=PSSTOT+1
  1. Q
  1. LOC ;Set local possible dosages
  1. N PSSOITEM,PSSOID,PSSLTOT,PSSLTOTX,PSDUPDPT,PSNOUN,PSNOUNPA,PSNOUNPT,PSALL,PSDOD,PSSLPT,PSSLPTX,PSSLPNO,PSSLP,PSSNL,PSSNLF,PSSNLX
  1. S PSSOITEM=$P($G(^PSDRUG(PSSDIEN,2)),"^") Q:'PSSOITEM
  1. S PSSOID=$P($G(^PS(50.7,PSSOITEM,0)),"^",2) Q:'PSSOID
  1. Q:'$O(^PS(50.606,PSSOID,"NOUN",0))
  1. I $O(^PSDRUG(PSSDIEN,"DOS2",0)) G LOCMRG
  1. I '$G(PSSTALK) G QUIET
  1. W ! K DIR S DIR("A")="This drug has no Local Possible Dosages, do you want to create them",DIR("B")="Y",DIR(0)="Y"
  1. S DIR("?")=" ",DIR("?",1)="If you answer 'YES', Local Possible Dosages will be created for this drug using",DIR("?",2)="nouns associated with the "_$P($G(^PS(50.606,+$G(PSSOID),0)),"^")_" Dosage Form."
  1. D ^DIR K DIR I Y'=1 Q
  1. W !!,"Setting Local Possible Dosages..",!
  1. K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. QUIET ;
  1. Q:'$O(^PS(50.606,PSSOID,"DUPD",0))
  1. I $O(^PS(50.606,PSSOID,"DUPD",0)) D S:PSSLTOT>1 PSSLTOTX=PSSLTOT-1,^PSDRUG(PSSDIEN,"DOS2",0)="^50.0904^"_$G(PSSLTOTX)_"^"_$G(PSSLTOTX) Q
  1. .S PSSLTOT=1
  1. .F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
  1. ..Q:PSNOUNPA=""
  1. ..F PSDOD=0:0 S PSDOD=$O(^PS(50.606,PSSOID,"DUPD",PSDOD)) Q:'PSDOD S PSDUPDPT=$P($G(^(PSDOD,0)),"^") D:PSDUPDPT'=""
  1. ...I $G(PSSONLYO),PSNOUNPA'["O" Q
  1. ...I $G(PSSONLYI),PSNOUNPA'["I" Q
  1. ...D TEST^PSSUTIL3
  1. ...S PSALL=$G(PSDUPDPT)_" "_$S($G(PSSNLF):$G(PSSNLX),1:$G(PSNOUNPT)) K PSSNL,PSSNLF,PSSNLX
  1. ...S ^PSDRUG(PSSDIEN,"DOS2",PSSLTOT,0)=$G(PSALL)_"^"_$G(PSNOUNPA),^PSDRUG(PSSDIEN,"DOS2","B",$E(PSALL,1,30),PSSLTOT)="" S PSSLTOT=PSSLTOT+1
  1. S PSSLTOT=1 F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
  1. .Q:PSNOUNPA=""
  1. .I $G(PSSONLYI),PSNOUNPA'["I" Q
  1. .I $G(PSSONLYO),PSNOUNPA'["O" Q
  1. .S ^PSDRUG(PSSDIEN,"DOS2",PSSLTOT,0)=PSNOUNPT_"^"_$G(PSNOUNPA),^PSDRUG(PSSDIEN,"DOS2","B",$E(PSNOUNPT,1,30),PSSLTOT)="" S PSSLTOT=PSSLTOT+1
  1. I PSSLTOT>1 S PSSLTOTX=PSSLTOT-1 S ^PSDRUG(PSSDIEN,"DOS2",0)="^50.0904^"_$G(PSSLTOTX)_"^"_$G(PSSLTOTX)
  1. Q
  1. LOCMRG ;Merge new Local Possible Dosages with existing ones
  1. N PSSLIEN,PSSLIENX,PSSPWZEX
  1. I '$G(PSSTALK),'$G(PSSUPRAF) G QUIET1
  1. W !!,"This drug has the following Local Possible Dosages:",!
  1. S PSSPWZEX=0 F PSSLIEN=0:0 S PSSLIEN=$O(^PSDRUG(PSSDIEN,"DOS2",PSSLIEN)) Q:'PSSLIEN!(PSSPWZEX) D
  1. .D:($Y+5)>IOSL XASK Q:PSSPWZEX S PSSLIENX=$P($G(^PSDRUG(PSSDIEN,"DOS2",PSSLIEN,0)),"^")
  1. .I $L(PSSLIENX)'>53 W !,PSSLIENX,?55,"PACKAGE: ",$P($G(^PSDRUG(PSSDIEN,"DOS2",PSSLIEN,0)),"^",2) D DOSEADX Q
  1. .W !,PSSLIENX,!,?55,"PACKAGE: ",$P($G(^PSDRUG(PSSDIEN,"DOS2",PSSLIEN,0)),"^",2) D DOSEADX
  1. W ! K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to merge new Local Possible Dosages"
  1. S DIR("?")=" ",DIR("?",1)="If you answer 'YES', any new Local Possible Dosages found based on the nouns",DIR("?",2)="associated with the "_$P($G(^PS(50.606,+$G(PSSOID),0)),"^")_" Dosage Form"
  1. S DIR("?",3)="will be added to you current Local Possible Dosages."
  1. D ^DIR K DIR I Y'=1 Q
  1. W !!,"Setting Local Possible Dosages..",!
  1. K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. QUIET1 ;
  1. Q:'$O(^PS(50.606,PSSOID,"DUPD",0))
  1. I $O(^PS(50.606,PSSOID,"DUPD",0)) D Q
  1. .F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
  1. ..Q:PSNOUNPA=""
  1. ..F PSDOD=0:0 S PSDOD=$O(^PS(50.606,PSSOID,"DUPD",PSDOD)) Q:'PSDOD S PSDUPDPT=$P($G(^(PSDOD,0)),"^") D:PSDUPDPT'=""
  1. ...I $G(PSSONLYO),PSNOUNPA'["O" Q
  1. ...I $G(PSSONLYI),PSNOUNPA'["I" Q
  1. ...D TEST^PSSUTIL3
  1. ...S PSALL=$G(PSDUPDPT)_" "_$S($G(PSSNLF):$G(PSSNLX),1:$G(PSNOUNPT)) K PSSNL,PSSNLF,PSSNLX
  1. ...S (PSSLPT,PSSLPTX,PSSLPNO)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSDIEN,"DOS2",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP I PSALL=$P($G(^PSDRUG(PSSDIEN,"DOS2",PSSLP,0)),"^") S PSSLPNO=1
  1. ...Q:PSSLPNO
  1. ...S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
  1. ...S ^PSDRUG(PSSDIEN,"DOS2",PSSLPT,0)=$G(PSALL)_"^"_$G(PSNOUNPA),^PSDRUG(PSSDIEN,"DOS2","B",$E(PSALL,1,30),PSSLPT)="",^PSDRUG(PSSDIEN,"DOS2",0)="^50.0904^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
  1. F PSNOUN=0:0 S PSNOUN=$O(^PS(50.606,PSSOID,"NOUN",PSNOUN)) Q:'PSNOUN S PSNOUNPT=$P($G(^(PSNOUN,0)),"^"),PSNOUNPA=$P($G(^(0)),"^",2) D:PSNOUNPT'=""
  1. .Q:PSNOUNPA=""
  1. .I $G(PSSONLYO),PSNOUNPA'["O" Q
  1. .I $G(PSSONLYI),PSNOUNPA'["I" Q
  1. .S (PSSLPT,PSSLPTX,PSSLPNO)=0 F PSSLP=0:0 S PSSLP=$O(^PSDRUG(PSSDIEN,"DOS2",PSSLP)) Q:'PSSLP S PSSLPTX=PSSLPTX+1 S PSSLPT=PSSLP I PSNOUNPT=$P($G(^PSDRUG(PSSDIEN,"DOS2",PSSLP,0)),"^") S PSSLPNO=1
  1. .Q:PSSLPNO
  1. .S PSSLPT=PSSLPT+1,PSSLPTX=PSSLPTX+1
  1. .S ^PSDRUG(PSSDIEN,"DOS2",PSSLPT,0)=$G(PSNOUNPT)_"^"_$G(PSNOUNPA),^PSDRUG(PSSDIEN,"DOS2","B",$E(PSNOUNPT,1,30),PSSLPT)="",^PSDRUG(PSSDIEN,"DOS2",0)="^50.0904^"_$G(PSSLPT)_"^"_$G(PSSLPTX)
  1. Q
  1. ;
  1. DOSEADD ;New fields added with PSS*1*147
  1. N PSSPW1,PSSPW2,PSSPW3,PSSPW4,PSSPW5,PSSPW6,PSSPW7,PSSPW8
  1. S PSSPW7=""
  1. S PSSPW1=$G(^PSDRUG(PSSDIEN,"DOS2",PSSLD,0))
  1. S PSSPW2=$P(PSSPW1,"^",3)
  1. S PSSPW3=$S($E(PSSPW2)=".":"0",1:"")_PSSPW2
  1. D:($Y+5)>IOSL ZASK Q:PSSPWXEX W !?3,"BCMA UNITS PER DOSE: "_PSSPW3
  1. S PSSPW4=$P(PSSPW1,"^",5),PSSPW5=$P(PSSPW1,"^",6)
  1. S PSSPW6=$S($E(PSSPW5)=".":"0",1:"")_PSSPW5
  1. I PSSPW4 S PSSPW7=$P($G(^PS(51.24,+PSSPW4,0)),"^")
  1. S PSSPW8=$L(PSSPW6)+$L(PSSPW7)
  1. D:($Y+5)>IOSL ZASK Q:PSSPWXEX I PSSPW8<49 W !?3,"NUMERIC DOSE: "_PSSPW6_" DOSE UNIT: "_PSSPW7 Q
  1. W !?3,"NUMERIC DOSE: "_PSSPW6
  1. W !?3,"DOSE UNIT: "_PSSPW7
  1. Q
  1. ;
  1. DOSEADX ;New fields added with PSS*1*147
  1. N PSSPWX1,PSSPWX2,PSSPWX3,PSSPWX4,PSSPWX5,PSSPWX6,PSSPWX7,PSSPWX8
  1. S PSSPWX7=""
  1. S PSSPWX1=$G(^PSDRUG(PSSDIEN,"DOS2",PSSLIEN,0))
  1. S PSSPWX2=$P(PSSPWX1,"^",3)
  1. S PSSPWX3=$S($E(PSSPWX2)=".":"0",1:"")_PSSPWX2
  1. D:($Y+5)>IOSL XASK Q:PSSPWZEX W !?3,"BCMA UNITS PER DOSE: "_PSSPWX3
  1. S PSSPWX4=$P(PSSPWX1,"^",5),PSSPWX5=$P(PSSPWX1,"^",6)
  1. S PSSPWX6=$S($E(PSSPWX5)=".":"0",1:"")_PSSPWX5
  1. I PSSPWX4 S PSSPWX7=$P($G(^PS(51.24,+PSSPWX4,0)),"^")
  1. S PSSPWX8=$L(PSSPWX6)+$L(PSSPWX7)
  1. D:($Y+5)>IOSL XASK Q:PSSPWZEX I PSSPWX8<49 W !?3,"NUMERIC DOSE: "_PSSPWX6_" DOSE UNIT: "_PSSPWX7 Q
  1. W !?3,"NUMERIC DOSE: "_PSSPWX6
  1. W !?3,"DOSE UNIT: "_PSSPWX7
  1. Q
  1. ;
  1. UNMDRUG(DRUGIEN) ; Un-match a Dispense Drug from a VA Product
  1. ;Input: DRGIEN - Pointer to the DRUG file (#50)
  1. ;
  1. N PIECE,VAPRDNAM,NDNODE,CMOPID,VAGENIEN,VAPRDIEN,PRIMDRG
  1. S DRUGIEN=+$G(DRUGIEN) Q:'DRUGIEN
  1. I '$D(^PSDRUG(DRUGIEN,"ND")) Q
  1. S NDNODE=$G(^PSDRUG(DRUGIEN,"ND"))
  1. S VAGENIEN=$P(NDNODE,"^",1) ; VA GENERIC (#50.6) Pointer
  1. S VAPRDNAM=$E($P(NDNODE,"^",2),1,30) ; VA PRODUCT NAME
  1. S VAPRDIEN=$P(NDNODE,"^",3) ; VA PRODUCT (#50.68) Pointer
  1. S PRIMDRG=$P($G(^PSDRUG(DRUGIEN,2)),"^",6) ; PRIMARY DRUG (#50.3) Pointer
  1. S CMOPID=$P(NDNODE,"^",10) ; CMOP ID
  1. F PIECE=1:1:5,10,11 S $P(^PSDRUG(DRUGIEN,"ND"),"^",PIECE)=""
  1. I VAPRDNAM'="" K ^PSDRUG("VAPN",VAPRDNAM,DRUGIEN)
  1. I CMOPID'="" K ^PSDRUG("AQ1",CMOPID,DRUGIEN)
  1. I PRIMDRG,VAPRDIEN,VAGENIEN K ^PSDRUG("APN",PRIMDRG,VAGENIEN_"A"_VAPRDIEN,DRUGIEN)
  1. I VAGENIEN K ^PSDRUG("AND",VAGENIEN,DRUGIEN)
  1. I VAPRDIEN K ^PSDRUG("APR",VAPRDIEN,DRUGIEN)
  1. Q
  1. ;
  1. ZASK ;Ask to continue
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit the list" D ^DIR K DIR I 'Y S PSSPWXEX=1
  1. W @IOF
  1. Q
  1. ;
  1. ;
  1. XASK ;Ask to continue
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit the list" D ^DIR K DIR I 'Y S PSSPWZEX=1
  1. W @IOF
  1. Q
  1. ;
  1. ;
  1. DASK ;Ask to continue
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. W @IOF
  1. Q
  1. ;
  1. ;****************************************************************
  1. ;*226 - A drug is considered Hazardous to Handle or Dispose if
  1. ; it is marked Hazardous in the PSNDF file #50.68 or points to a
  1. ; common Orderable Item that is pointed to by any drug that is
  1. ; marked as such.
  1. ;****************************************************************
  1. HAZ(PSSIEN,PSSF) ;*226
  1. ; Determine if a Drug is Hazardous to Handle and to Dispose.
  1. ; Pass in Drug IEN if known or pass in the OI IEN if preferred.
  1. ; Input: PSSIEN - IEN of either Drug file or Pharmacy OI file. <required>
  1. ; PSSF - "OI" passed in, then IEN is Pharmacy OI file, else <optional>
  1. ; "OI" Not passed in, then IEN is for Drug file. <default>
  1. ; Output: HAZ Handle flag (1/0 ^ HAZ Dispose flag (1/0) ^ Orderable Item name
  1. N PSSOI,PSSOINAM S PSSIEN=+$G(PSSIEN),PSSF=$G(PSSF)
  1. S PSSDR=$S(PSSF'="OI":PSSIEN,1:0)
  1. S PSSOI=$S(PSSF="OI":PSSIEN,1:$$GET1^DIQ(50,PSSIEN,"PHARMACY ORDERABLE ITEM","I")),PSSOINAM=$$GET1^DIQ(50.7,PSSOI,"NAME")
  1. Q $$ISHAZ(PSSDR,PSSOI,"HAZARDOUS TO HANDLE")_U_$$ISHAZ(PSSDR,PSSOI,"HAZARDOUS TO DISPOSE")_U_PSSOINAM
  1. ;
  1. ISHAZ(DRIEN,OIIEN,FLDNAM) ;*226
  1. ; Get Hazardous flag by NDF FLDNAM passed in to test
  1. N HAZ,NDIEN,QQ
  1. ;quick Drug check if Haz = 1
  1. I DRIEN S NDIEN=+$$GET1^DIQ(50,DRIEN,"PSNDF VA PRODUCT NAME ENTRY","I") I +$$GET1^DIQ(50.68,NDIEN,FLDNAM,"I") Q 1
  1. ;Pharm Orderable item check if a related drug(s) via OI xref are Haz true. Quit upon Haz true found.
  1. I 'OIIEN Q 0
  1. S HAZ=0 F QQ=0:0 S QQ=$O(^PSDRUG("ASP",OIIEN,QQ)) Q:'QQ D Q:HAZ
  1. . S NDIEN=+$$GET1^DIQ(50,QQ,"PSNDF VA PRODUCT NAME ENTRY","I")
  1. . S HAZ=+$$GET1^DIQ(50.68,NDIEN,FLDNAM,"I")
  1. Q HAZ
  1. ;
  1. HAZWARNG(PSSDRIEN,PSSIO,PSSHAZH,PSSHAZD,PSSHAZTX) ;*226
  1. ; Hazardous standard text warning based on HAZ flags passed in
  1. ; Input: PSSDRIEN - DRUG file #50 IEN
  1. ; PSSIO - Inpatient or Outpatient (I - Clinicians only type warn) (O - Patient type warn)
  1. ; PSSHAZH - Haz to handle indicated
  1. ; PSSHAZD - Haz to Dispose indicated
  1. ; Output: PSSHAZTX - text for the specific warning indicated, if only one or both Haz indicators exist.
  1. ; (Not wrapped, calling routine needs to do word wrap for printing and displaying)
  1. Q:'PSSDRIEN
  1. S PSSIO=$G(PSSIO),PSSHAZH=$G(PSSHAZH),PSSHAZD=$G(PSSHAZD)
  1. Q:('PSSHAZH)&('PSSHAZD)
  1. S PSSHAZTX=$$GET1^DIQ(50,PSSDRIEN,"PHARMACY ORDERABLE ITEM")_" is hazardous to "
  1. S:(PSSHAZH&'PSSHAZD) PSSHAZTX=PSSHAZTX_"handle. "
  1. S:('PSSHAZH&PSSHAZD) PSSHAZTX=PSSHAZTX_"dispose. "
  1. S:(PSSHAZH&PSSHAZD) PSSHAZTX=PSSHAZTX_"handle and dispose. "
  1. I PSSIO="O" S PSSHAZTX=PSSHAZTX_"Please notify pharmacy staff and counsel patient to take the appropriate "
  1. I PSSIO="I" S PSSHAZTX=PSSHAZTX_"Please take the appropriate "
  1. S:(PSSHAZH&'PSSHAZD) PSSHAZTX=PSSHAZTX_"handling precautions."
  1. S:('PSSHAZH&PSSHAZD) PSSHAZTX=PSSHAZTX_"disposal precautions."
  1. S:(PSSHAZH&PSSHAZD) PSSHAZTX=PSSHAZTX_"handling and disposal precautions."
  1. Q