source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSWMAP.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PSSWMAP ;BIR/EJW-MAP WARNINGS FROM RX CONSULT FILE TO FDB ;05/21/04
2 ;;1.0;PHARMACY DATA MANAGEMENT;**87**;9/30/97
3 ;
4 ;Reference to ^PS(50.625 supported by DBIA 4445
5 ; This routine provides the ability to map entries from the RX CONSULT file (#54)
6 ; to the new warning data source - First Data Bank's WARNING LABEL-ENGLISH file (#50.625)
7 ; USERS CAN ENTER THEIR OWN MAPPING TO BE USED WITH THE WARNING LABEL BUILDER
8 ;
9 Q
10FILL ;
11 D BMES^XPDUTL("Populating the warning mapping from RX CONSULT file entries 1-6,8-11,12,13")
12 D BMES^XPDUTL("and 15 to the equivalent WARNING LABEL-ENGLISH file entries.")
13 N JJ
14 F JJ=1:1:6,8:1:11 S DIE="^PS(54,",DA=JJ,DR="2///"_JJ D ^DIE K DIE,DA,DR
15 S DIE="^PS(54,",DA=12,DR="2///19" D ^DIE K DIE,DA,DR
16 S DIE="^PS(54,",DA=13,DR="2///20" D ^DIE K DIE,DA,DR
17 S DIE="^PS(54,",DA=15,DR="2///30" D ^DIE K DIE,DA,DR
18 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
19 D BMES^XPDUTL("Mapping complete and Spanish translation for warning number 20 populated.")
20 Q
21EDIT ; ADD WARNING MAPPING AND/OR SPANISH TRANSLATION TO RX CONSULT FILE ENTRY
22 N MAP,NEW,RXNUM,PSSTXT
23 W !!," Note: Warning mapping is only used as an aid when using the warning builder."
24 W !," If a DRUG WARNING is defined with a warning mapping of 0, that entry will be"
25 W !," skipped when choosing option 6 Drug has WARNING LABEL that does not map to"
26 W !," new data source."
27 D HDR
28 S RXNUM=0 F S RXNUM=$O(^PS(54,RXNUM)) Q:'RXNUM D
29 .D FULL I '$G(PSSOUT) W !,RXNUM,?8,$P($G(^PS(54,RXNUM,0)),"^"),?40," ",$G(^PS(54,RXNUM,2))
30EDIT1 W ! S DIC=54,DIC(0)="AEMQ",DIC("A")="Enter a valid Rx Consult file number: " D ^DIC K DIC I Y<1 Q
31 S RXNUM=+Y
32 S PSSTXT=0 F S PSSTXT=$O(^PS(54,RXNUM,1,PSSTXT)) Q:'PSSTXT W !,?3,^PS(54,RXNUM,1,PSSTXT,0)
33 W !
34 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
35 .S PSSTXT=0 F S PSSTXT=$O(^PS(50.625,MAP,1,PSSTXT)) Q:'PSSTXT W !,?3,^PS(50.625,MAP,1,PSSTXT,0)
36 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
37 I Y<0!($E(Y)="^") G SPANISH
38 S NEW=+Y
39 S DIE="^PS(54,",DA=RXNUM,DR="2///"_NEW D ^DIE K DIE,DA,DR
40 S PSSTXT=0 F S PSSTXT=$O(^PS(50.625,NEW,1,PSSTXT)) Q:'PSSTXT W !,?3,^PS(50.625,NEW,1,PSSTXT,0)
41 G SPANISH
42ASK K DIR W ! S DIR(0)="Y",DIR("B")="N",DIR("A")="Do you want to change the mapping" D ^DIR K DIR
43 I 'Y G SPANISH
44 S DIE="^PS(54,",DA=RXNUM,DR="2" D ^DIE K DIE,DA,DR
45 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)
46SPANISH ;
47 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
48 I 'Y W ! G EDIT1
49 S DIE="^PS(54,",DA=RXNUM,DR=3 D ^DIE K DIE,DA,DR
50 W ! G EDIT1
51 Q
52 ;
53FULL ;
54 I ($Y+3)>IOSL&('$G(PSSOUT)) D HDR
55 Q
56HDR ;
57 K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSSOUT=1,QUIT=1 Q
58 W @IOF
59 W !!," CURRENT WARNING MAPPING",!!
60 W "DRUG WARNING",?30,"Mapped to New data source number"
61 Q
Note: See TracBrowser for help on using the repository browser.