- 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 Feb 19, 2025@00:00:50 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