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

PSSWMAP.m

Go to the documentation of this file.
  1. PSSWMAP ;BIR/EJW-MAP WARNINGS FROM RX CONSULT FILE TO FDB ;05/21/04
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97
  1. ;
  1. ;Reference to ^PS(50.625 supported by DBIA 4445
  1. ; This routine provides the ability to map entries from the RX CONSULT file (#54)
  1. ; to the new warning data source - First Data Bank's WARNING LABEL-ENGLISH file (#50.625)
  1. ; USERS CAN ENTER THEIR OWN MAPPING TO BE USED WITH THE WARNING LABEL BUILDER
  1. ;
  1. Q
  1. FILL ;
  1. D BMES^XPDUTL("Populating the warning mapping from RX CONSULT file entries 1-6,8-11,12,13")
  1. D BMES^XPDUTL("and 15 to the equivalent WARNING LABEL-ENGLISH file entries.")
  1. N JJ
  1. F JJ=1:1:6,8:1:11 S DIE="^PS(54,",DA=JJ,DR="2///"_JJ D ^DIE K DIE,DA,DR
  1. S DIE="^PS(54,",DA=12,DR="2///19" D ^DIE K DIE,DA,DR
  1. S DIE="^PS(54,",DA=13,DR="2///20" D ^DIE K DIE,DA,DR
  1. S DIE="^PS(54,",DA=15,DR="2///30" D ^DIE K DIE,DA,DR
  1. S DIE="^PS(54,",DA=20,DR="3///PRECAUCION: La ley federal prohibe la transferencia de este medicamento a otro paciente para el que no fue recetado." D ^DIE K DIE,DA,DR
  1. D BMES^XPDUTL("Mapping complete and Spanish translation for warning number 20 populated.")
  1. Q
  1. EDIT ; ADD WARNING MAPPING AND/OR SPANISH TRANSLATION TO RX CONSULT FILE ENTRY
  1. N MAP,NEW,RXNUM,PSSTXT
  1. W !!," Note: Warning mapping is only used as an aid when using the warning builder."
  1. W !," If a DRUG WARNING is defined with a warning mapping of 0, that entry will be"
  1. W !," skipped when choosing option 6 Drug has WARNING LABEL that does not map to"
  1. W !," new data source."
  1. D HDR
  1. S RXNUM=0 F S RXNUM=$O(^PS(54,RXNUM)) Q:'RXNUM D
  1. .D FULL I '$G(PSSOUT) W !,RXNUM,?8,$P($G(^PS(54,RXNUM,0)),"^"),?40," ",$G(^PS(54,RXNUM,2))
  1. EDIT1 W ! S DIC=54,DIC(0)="AEMQ",DIC("A")="Enter a valid Rx Consult file number: " D ^DIC K DIC I Y<1 Q
  1. S RXNUM=+Y
  1. S PSSTXT=0 F S PSSTXT=$O(^PS(54,RXNUM,1,PSSTXT)) Q:'PSSTXT W !,?3,^PS(54,RXNUM,1,PSSTXT,0)
  1. W !
  1. S MAP=$P($G(^PS(54,RXNUM,2)),"^") I MAP'="" W !,"Rx Consult file number "_RXNUM_" is mapped to WARNING LABEL-ENGLISH number "_MAP D G ASK
  1. .S PSSTXT=0 F S PSSTXT=$O(^PS(50.625,MAP,1,PSSTXT)) Q:'PSSTXT W !,?3,^PS(50.625,MAP,1,PSSTXT,0)
  1. K DIR W ! S DIR(0)="N0",DIR("B")=$S(MAP'="":MAP,1:""),DIR("A")="Enter a number from WARNING LABEL-ENGLISH file to map to: " D ^DIR K DIR
  1. I Y<0!($E(Y)="^") G SPANISH
  1. S NEW=+Y
  1. S DIE="^PS(54,",DA=RXNUM,DR="2///"_NEW D ^DIE K DIE,DA,DR
  1. S PSSTXT=0 F S PSSTXT=$O(^PS(50.625,NEW,1,PSSTXT)) Q:'PSSTXT W !,?3,^PS(50.625,NEW,1,PSSTXT,0)
  1. G SPANISH
  1. ASK K DIR W ! S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to change the mapping" D ^DIR K DIR
  1. I 'Y G SPANISH
  1. S DIE="^PS(54,",DA=RXNUM,DR="2" D ^DIE K DIE,DA,DR
  1. I X>0 S PSSTXT=0 F S PSSTXT=$O(^PS(50.625,X,1,PSSTXT)) Q:'PSSTXT W !,?3,^PS(50.625,X,1,PSSTXT,0)
  1. SPANISH ;
  1. K DIR W ! S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to enter/edit a Spanish translation for this entry" D ^DIR K DIR
  1. I 'Y W ! G EDIT1
  1. S DIE="^PS(54,",DA=RXNUM,DR=3 D ^DIE K DIE,DA,DR
  1. W ! G EDIT1
  1. Q
  1. ;
  1. FULL ;
  1. I ($Y+3)>IOSL&('$G(PSSOUT)) D HDR
  1. Q
  1. HDR ;
  1. K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1,QUIT=1 Q
  1. W @IOF
  1. W !!," CURRENT WARNING MAPPING",!!
  1. W "DRUG WARNING",?30,"Mapped to New data source number"
  1. Q