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