PSSCUSRQ ;BIR/RTR-Request Customization changes ;04/01/09
;;1.0;PHARMACY DATA MANAGEMENT;**117**;9/30/97;Build 101
;
;Request customization changes
;
EN ;
N DDWAUTO,DDWTAB,DWDISABL,DIWEPSE,DIWETXT,DDWLMAR,DDWRMAR,DDWRW,DDWC,DDWFLAGS,DIWESUB,DWLW,DWPK
N J,%,D0,D1,D2,DG,DIC,DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT
N PSSCQOUT,PSSCQANS,PSSCQPRM,PSSCQPMM,PSSCQVIS,PSSCQVAL,PSSCQCCT
S PSSCQOUT=0
K DIR S DIR(0)="SO^N:New Drug Interaction;S:Drug Interaction Severity Change;T:Duplicate Therapy Change;D:Dosing Change",DIR("A")="Select one of the above"
S DIR("?")=" ",DIR("?",1)="Enter 'N' to request that a new Drug/Drug interaction be added, enter 'S' to"
S DIR("?",2)="request a severity change to an existing Drug/Drug interaction, enter 'T' to",DIR("?",3)="request a Duplicate Therapy change, enter 'D' to request a Dosing change."
;DOSING - When Dosing comes out, uncomment previous 3 lines, delete next 3 lines
;K DIR S DIR(0)="SO^N:New Drug Interaction;S:Drug Interaction Severity Change;T:Duplicate Therapy Change",DIR("A")="Select one of the above"
;S DIR("?")=" ",DIR("?",1)="Enter 'N' to request that a new Drug/Drug interaction be added, enter 'S' to"
;S DIR("?",2)="request a severity change to an existing Drug/Drug interaction, enter 'T' to",DIR("?",3)="request a Duplicate Therapy change."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
I Y'="N",Y'="S",Y'="T",Y'="D" D MESS Q
;DOSING - When Dosing comes out, uncomment previous line, delete next line
;I Y'="N",Y'="S",Y'="T" D MESS Q
S PSSCQANS=Y
D FIN
I PSSCQANS="N" D NDI D FIN D:PSSCQOUT MESS Q
I PSSCQANS="S" D DISC D FIN D:PSSCQOUT MESS Q
I PSSCQANS="T" D DTC D FIN D:PSSCQOUT MESS Q
;DOSING - Uncomment next line when Dosing comes out
I PSSCQANS="D" D DC D FIN D:PSSCQOUT MESS
Q
;
;
MESS ;Exit Message
W !!,"No Action Taken.",!
K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
;
;
NDI ;New Drug Interaction
N PSSCQNDD,PSSCQNSV
W ! K DIR,Y S DIR(0)="FO^1:78",DIR("A")="Enter Interacting Drug Names (free text)",DIR("?")=" ",DIR("?",1)="Enter the names of the Drugs for the new Drug/Drug Interaction"
S DIR("?",2)="that you are requesting, 1 to 78 characters."
D ^DIR K DIR I $D(DIRUT)!($D(DUOUT))!($D(DTOUT)) S PSSCQOUT=1 Q
S PSSCQNDD=Y
;
K DIR,Y S DIR(0)="SO^1:Critical;2:Significant",DIR("A")="Enter Severity"
S DIR("?")=" ",DIR("?",1)="Enter '1' to request that this new Drug/Drug interaction be classified"
S DIR("?",2)="as Critical, enter '2' to request it be classified as Significant."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S PSSCQOUT=1 Q
I Y'=1,Y'=2 S PSSCQOUT=1 Q
S PSSCQNSV=Y
;
W !!,"You must now enter a reason or references for this request. <word processing>",!
K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSCQOUT=1 Q
W ! D KLWRD S DIWESUB="References/Reason for Request",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
;
W ! S PSSCQPRM=1 D TEST(PSSCQPRM)
Q
;
;
DISC ;Drug Interaction Severity Change
N PSSCQSDD,PSSCQSSV
W ! K DIR,Y S DIR(0)="FO^1:78",DIR("A")="Enter Interacting Drug Names (free text)",DIR("?")=" ",DIR("?",1)="Enter the names of the Drugs of the Drug/Drug Interaction that you"
S DIR("?",2)="would like to see the severity changed for, 1 to 78 characters."
D ^DIR K DIR I $D(DIRUT)!($D(DUOUT))!($D(DTOUT)) S PSSCQOUT=1 Q
S PSSCQSDD=Y
;
K DIR,Y S DIR(0)="SO^1:Critical;2:Significant",DIR("A")="Change Severity To"
S DIR("?")=" ",DIR("?",1)="Enter '1' to request that this Drug/Drug interaction severity be changed"
S DIR("?",2)="to Critical, enter '2' to request it be changed to Significant."
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S PSSCQOUT=1 Q
I Y'=1,Y'=2 S PSSCQOUT=1 Q
S PSSCQSSV=Y
;
W !!,"You must now enter a reason or references for this request. <word processing>",!
K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSCQOUT=1 Q
W ! D KLWRD S DIWESUB="References/Reason for Request",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
;
W ! S PSSCQPRM=2 D TEST(PSSCQPRM)
Q
;
;
DTC ;Duplicate Therapy Change
W !!,"You must now enter a description of the change/problem. <word processing>",!
K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSCQOUT=1 Q
W ! D KLWRD S DIWESUB="Description of change/problem",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
;
W ! S PSSCQPRM=3 D TEST(PSSCQPRM)
Q
;
;
DC ;Dosing Change
;DOSING - This code should never be called until Dosing comes out, when it does remove next line (Quit)
;Q
W !!,"You must now enter a description of the change/problem. <word processing>",!
K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSCQOUT=1 Q
W ! D KLWRD S DIWESUB="Description of change/problem",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
;
W ! S PSSCQPRM=4 D TEST(PSSCQPRM)
Q
;
;
FIN ;Clean Up
K ^TMP($J,"PSSCQTXT")
K ^TMP($J,"PSSCQWP")
Q
;
;
TEST(PSSCQPMM) ;Prompt to send Mail Message
;For Dosing, add a check for 4 in the next line
I PSSCQPMM'=1,PSSCQPMM'=2,PSSCQPMM'=3,PSSCQPMM'=4 W !!,"Problem with option, please enter a Remedy ticket." S PSSCQOUT=1 Q
S PSSCQCCT=1
I '$$PROD^XUPROD S PSSCQCCT=0 W !!,"NOTE: This is a test account. Regardless of your response to the 'Transmit'",!,"prompt, this request will NOT be sent forward for national review.",!
K DIR,Y S DIR(0)="Y",DIR("B")="Y"
S DIR("A")=$S(PSSCQPMM=1:"Transmit New Drug Interaction Request",PSSCQPMM=2:"Transmit Drug Interaction Severity Change Request",PSSCQPMM=3:"Transmit Duplicate Therapy Change Request",PSSCQPMM=4:"Transmit Dosing Change Request",1:"Transmit")
;DOSING - when dosing comes out, remove next line and uncomment previous line
;S DIR("A")=$S(PSSCQPMM=1:"Transmit New Drug Interaction Request",PSSCQPMM=2:"Transmit Drug Interaction Severity Change Request",PSSCQPMM=3:"Transmit Duplicate Therapy Change Request",1:"Transmit")
S DIR("?")=" ",DIR("?",1)="Enter 'Y' to transmit this request for review. (For production accounts only)"
S DIR("?",2)="If you enter 'N', the message will sent to you only, in Vista mail.",DIR("?",3)="Enter '^' to exit, and not send the message."
D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT)) S PSSCQOUT=1 Q
S PSSCQVIS=0
I Y'=1 S PSSCQVIS=1 D SEND(PSSCQPMM) W !!,"Mail message only sent to you in Vista Mail.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
D SEND(PSSCQPMM) W !!,"Mail message transmitted for review.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
;
;
SEND(PSSCQVAL) ;Send Mail Message
N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMDUN,DIFROM,XMYBLOB,XMZ,PSSCQLP,PSSCQCNT
I PSSCQVAL=1 D NDITXT G PASS
I PSSCQVAL=2 D DISCTXT G PASS
I PSSCQVAL=3 D DTCTXT G PASS
;DOSING - when Dosing comes out, uncomment next line
I PSSCQVAL=4 D DCTXT
PASS ;
S XMSUB=$S(PSSCQVAL=1:"New Drug Interaction Request",PSSCQVAL=2:"Drug Interaction Severity Change Request",PSSCQVAL=3:"Duplicate Therapy Change Request",PSSCQVAL=4:"Dosing Change Request",1:"Unknown Request")
;DOSING - when Dosing comes out, remove next line and uncomment previous line
;S XMSUB=$S(PSSCQVAL=1:"New Drug Interaction Request",PSSCQVAL=2:"Drug Interaction Severity Change Request",PSSCQVAL=3:"Duplicate Therapy Change Request",1:"Unknown Request")
S XMDUZ=DUZ
S XMTEXT="^TMP($J,""PSSCQTXT"","
S XMY(DUZ)=""
I 'PSSCQVIS,PSSCQCCT S XMY("VAOITVHITPSCUSTOMREQ@domain.ext")=""
D ^XMD
Q
;
;
NDITXT ;Format text message for New Drug Interaction
S ^TMP($J,"PSSCQTXT",1,0)="Request New Drug Interaction:"
S ^TMP($J,"PSSCQTXT",2,0)=$G(PSSCQNDD)
S ^TMP($J,"PSSCQTXT",3,0)=" "
S ^TMP($J,"PSSCQTXT",4,0)="Severity:"
S ^TMP($J,"PSSCQTXT",5,0)=$S($G(PSSCQNSV)=1:"CRITICAL",$G(PSSCQNSV)=2:"SIGNIFICANT",1:"UNKNOWN")
S ^TMP($J,"PSSCQTXT",6,0)=" "
S PSSCQCNT=7
F PSSCQLP=0:0 S PSSCQLP=$O(^TMP($J,"PSSCQWP",PSSCQLP)) Q:'PSSCQLP S ^TMP($J,"PSSCQTXT",PSSCQCNT,0)=$G(^TMP($J,"PSSCQWP",PSSCQLP,0)) S PSSCQCNT=PSSCQCNT+1
Q
;
;
DISCTXT ;Format text message for Drug Interaction Severity Change
S ^TMP($J,"PSSCQTXT",1,0)="Drug-Drug Interaction:"
S ^TMP($J,"PSSCQTXT",2,0)=$G(PSSCQSDD)
S ^TMP($J,"PSSCQTXT",3,0)=" "
S ^TMP($J,"PSSCQTXT",4,0)="Severity Change To:"
S ^TMP($J,"PSSCQTXT",5,0)=$S($G(PSSCQSSV)=1:"CRITICAL",$G(PSSCQSSV)=2:"SIGNIFICANT",1:"UNKNOWN")
S ^TMP($J,"PSSCQTXT",6,0)=" "
S PSSCQCNT=7
F PSSCQLP=0:0 S PSSCQLP=$O(^TMP($J,"PSSCQWP",PSSCQLP)) Q:'PSSCQLP S ^TMP($J,"PSSCQTXT",PSSCQCNT,0)=$G(^TMP($J,"PSSCQWP",PSSCQLP,0)) S PSSCQCNT=PSSCQCNT+1
Q
;
;
DTCTXT ;Format text message for Duplicate Therapy Change
S ^TMP($J,"PSSCQTXT",1,0)="Duplicate Therapy Change Description/Problem:"
S ^TMP($J,"PSSCQTXT",2,0)=" "
S PSSCQCNT=3
F PSSCQLP=0:0 S PSSCQLP=$O(^TMP($J,"PSSCQWP",PSSCQLP)) Q:'PSSCQLP S ^TMP($J,"PSSCQTXT",PSSCQCNT,0)=$G(^TMP($J,"PSSCQWP",PSSCQLP,0)) S PSSCQCNT=PSSCQCNT+1
Q
;
;
DCTXT ;Format text message for Dosing Change
;DOSING - Should never be called until Dosing comes out. When Dosing does come out, remove next line (Quit)
;Q
S ^TMP($J,"PSSCQTXT",1,0)="Dosing Change Description/Problem:"
S ^TMP($J,"PSSCQTXT",2,0)=" "
S PSSCQCNT=3
F PSSCQLP=0:0 S PSSCQLP=$O(^TMP($J,"PSSCQWP",PSSCQLP)) Q:'PSSCQLP S ^TMP($J,"PSSCQTXT",PSSCQCNT,0)=$G(^TMP($J,"PSSCQWP",PSSCQLP,0)) S PSSCQCNT=PSSCQCNT+1
Q
;
;
KLWRD ;
K DDWAUTO,DDWTAB,DWDISABL,DIWEPSE,DIWETXT,DDWLMAR,DDWRMAR,DDWRW,DDWC,DDWFLAGS,DIWESUB,DWLW,DWPK,DIC
K ^TMP($J,"PSSCQWP")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSCUSRQ 9924 printed Sep 23, 2025@20:06:17 Page 2
PSSCUSRQ ;BIR/RTR-Request Customization changes ;04/01/09
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**117**;9/30/97;Build 101
+2 ;
+3 ;Request customization changes
+4 ;
EN ;
+1 NEW DDWAUTO,DDWTAB,DWDISABL,DIWEPSE,DIWETXT,DDWLMAR,DDWRMAR,DDWRW,DDWC,DDWFLAGS,DIWESUB,DWLW,DWPK
+2 NEW J,%,D0,D1,D2,DG,DIC,DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT
+3 NEW PSSCQOUT,PSSCQANS,PSSCQPRM,PSSCQPMM,PSSCQVIS,PSSCQVAL,PSSCQCCT
+4 SET PSSCQOUT=0
+5 KILL DIR
SET DIR(0)="SO^N:New Drug Interaction;S:Drug Interaction Severity Change;T:Duplicate Therapy Change;D:Dosing Change"
SET DIR("A")="Select one of the above"
+6 SET DIR("?")=" "
SET DIR("?",1)="Enter 'N' to request that a new Drug/Drug interaction be added, enter 'S' to"
+7 SET DIR("?",2)="request a severity change to an existing Drug/Drug interaction, enter 'T' to"
SET DIR("?",3)="request a Duplicate Therapy change, enter 'D' to request a Dosing change."
+8 ;DOSING - When Dosing comes out, uncomment previous 3 lines, delete next 3 lines
+9 ;K DIR S DIR(0)="SO^N:New Drug Interaction;S:Drug Interaction Severity Change;T:Duplicate Therapy Change",DIR("A")="Select one of the above"
+10 ;S DIR("?")=" ",DIR("?",1)="Enter 'N' to request that a new Drug/Drug interaction be added, enter 'S' to"
+11 ;S DIR("?",2)="request a severity change to an existing Drug/Drug interaction, enter 'T' to",DIR("?",3)="request a Duplicate Therapy change."
+12 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
DO MESS
QUIT
+13 IF Y'="N"
IF Y'="S"
IF Y'="T"
IF Y'="D"
DO MESS
QUIT
+14 ;DOSING - When Dosing comes out, uncomment previous line, delete next line
+15 ;I Y'="N",Y'="S",Y'="T" D MESS Q
+16 SET PSSCQANS=Y
+17 DO FIN
+18 IF PSSCQANS="N"
DO NDI
DO FIN
if PSSCQOUT
DO MESS
QUIT
+19 IF PSSCQANS="S"
DO DISC
DO FIN
if PSSCQOUT
DO MESS
QUIT
+20 IF PSSCQANS="T"
DO DTC
DO FIN
if PSSCQOUT
DO MESS
QUIT
+21 ;DOSING - Uncomment next line when Dosing comes out
+22 IF PSSCQANS="D"
DO DC
DO FIN
if PSSCQOUT
DO MESS
+23 QUIT
+24 ;
+25 ;
MESS ;Exit Message
+1 WRITE !!,"No Action Taken.",!
+2 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+3 QUIT
+4 ;
+5 ;
NDI ;New Drug Interaction
+1 NEW PSSCQNDD,PSSCQNSV
+2 WRITE !
KILL DIR,Y
SET DIR(0)="FO^1:78"
SET DIR("A")="Enter Interacting Drug Names (free text)"
SET DIR("?")=" "
SET DIR("?",1)="Enter the names of the Drugs for the new Drug/Drug Interaction"
+3 SET DIR("?",2)="that you are requesting, 1 to 78 characters."
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT))
SET PSSCQOUT=1
QUIT
+5 SET PSSCQNDD=Y
+6 ;
+7 KILL DIR,Y
SET DIR(0)="SO^1:Critical;2:Significant"
SET DIR("A")="Enter Severity"
+8 SET DIR("?")=" "
SET DIR("?",1)="Enter '1' to request that this new Drug/Drug interaction be classified"
+9 SET DIR("?",2)="as Critical, enter '2' to request it be classified as Significant."
+10 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET PSSCQOUT=1
QUIT
+11 IF Y'=1
IF Y'=2
SET PSSCQOUT=1
QUIT
+12 SET PSSCQNSV=Y
+13 ;
+14 WRITE !!,"You must now enter a reason or references for this request. <word processing>",!
+15 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSCQOUT=1
QUIT
+16 WRITE !
DO KLWRD
SET DIWESUB="References/Reason for Request"
SET DWLW=78
SET DWPK=1
SET DIC="^TMP($J,""PSSCQWP"","
DO EN^DIWE
+17 IF '$DATA(^TMP($JOB,"PSSCQWP"))
WRITE !!,"No data was entered."
SET PSSCQOUT=1
QUIT
+18 ;
+19 WRITE !
SET PSSCQPRM=1
DO TEST(PSSCQPRM)
+20 QUIT
+21 ;
+22 ;
DISC ;Drug Interaction Severity Change
+1 NEW PSSCQSDD,PSSCQSSV
+2 WRITE !
KILL DIR,Y
SET DIR(0)="FO^1:78"
SET DIR("A")="Enter Interacting Drug Names (free text)"
SET DIR("?")=" "
SET DIR("?",1)="Enter the names of the Drugs of the Drug/Drug Interaction that you"
+3 SET DIR("?",2)="would like to see the severity changed for, 1 to 78 characters."
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT))
SET PSSCQOUT=1
QUIT
+5 SET PSSCQSDD=Y
+6 ;
+7 KILL DIR,Y
SET DIR(0)="SO^1:Critical;2:Significant"
SET DIR("A")="Change Severity To"
+8 SET DIR("?")=" "
SET DIR("?",1)="Enter '1' to request that this Drug/Drug interaction severity be changed"
+9 SET DIR("?",2)="to Critical, enter '2' to request it be changed to Significant."
+10 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET PSSCQOUT=1
QUIT
+11 IF Y'=1
IF Y'=2
SET PSSCQOUT=1
QUIT
+12 SET PSSCQSSV=Y
+13 ;
+14 WRITE !!,"You must now enter a reason or references for this request. <word processing>",!
+15 KILL DIR,Y
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSCQOUT=1
QUIT
+16 WRITE !
DO KLWRD
SET DIWESUB="References/Reason for Request"
SET DWLW=78
SET DWPK=1
SET DIC="^TMP($J,""PSSCQWP"","
DO EN^DIWE
+17 IF '$DATA(^TMP($JOB,"PSSCQWP"))
WRITE !!,"No data was entered."
SET PSSCQOUT=1
QUIT
+18 ;
+19 WRITE !
SET PSSCQPRM=2
DO TEST(PSSCQPRM)
+20 QUIT
+21 ;
+22 ;
DTC ;Duplicate Therapy Change
+1 WRITE !!,"You must now enter a description of the change/problem. <word processing>",!
+2 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSCQOUT=1
QUIT
+3 WRITE !
DO KLWRD
SET DIWESUB="Description of change/problem"
SET DWLW=78
SET DWPK=1
SET DIC="^TMP($J,""PSSCQWP"","
DO EN^DIWE
+4 IF '$DATA(^TMP($JOB,"PSSCQWP"))
WRITE !!,"No data was entered."
SET PSSCQOUT=1
QUIT
+5 ;
+6 WRITE !
SET PSSCQPRM=3
DO TEST(PSSCQPRM)
+7 QUIT
+8 ;
+9 ;
DC ;Dosing Change
+1 ;DOSING - This code should never be called until Dosing comes out, when it does remove next line (Quit)
+2 ;Q
+3 WRITE !!,"You must now enter a description of the change/problem. <word processing>",!
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSCQOUT=1
QUIT
+5 WRITE !
DO KLWRD
SET DIWESUB="Description of change/problem"
SET DWLW=78
SET DWPK=1
SET DIC="^TMP($J,""PSSCQWP"","
DO EN^DIWE
+6 IF '$DATA(^TMP($JOB,"PSSCQWP"))
WRITE !!,"No data was entered."
SET PSSCQOUT=1
QUIT
+7 ;
+8 WRITE !
SET PSSCQPRM=4
DO TEST(PSSCQPRM)
+9 QUIT
+10 ;
+11 ;
FIN ;Clean Up
+1 KILL ^TMP($JOB,"PSSCQTXT")
+2 KILL ^TMP($JOB,"PSSCQWP")
+3 QUIT
+4 ;
+5 ;
TEST(PSSCQPMM) ;Prompt to send Mail Message
+1 ;For Dosing, add a check for 4 in the next line
+2 IF PSSCQPMM'=1
IF PSSCQPMM'=2
IF PSSCQPMM'=3
IF PSSCQPMM'=4
WRITE !!,"Problem with option, please enter a Remedy ticket."
SET PSSCQOUT=1
QUIT
+3 SET PSSCQCCT=1
+4 IF '$$PROD^XUPROD
SET PSSCQCCT=0
WRITE !!,"NOTE: This is a test account. Regardless of your response to the 'Transmit'",!,"prompt, this request will NOT be sent forward for national review.",!
+5 KILL DIR,Y
SET DIR(0)="Y"
SET DIR("B")="Y"
+6 SET DIR("A")=$SELECT(PSSCQPMM=1:"Transmit New Drug Interaction Request",PSSCQPMM=2:"Transmit Drug Interaction Severity Change Request",PSSCQPMM=3:"Transmit Duplicate Therapy Change Request",PSSCQPMM=4:"Transmit Dosing Change Request",1:"Transmi
t")
+7 ;DOSING - when dosing comes out, remove next line and uncomment previous line
+8 ;S DIR("A")=$S(PSSCQPMM=1:"Transmit New Drug Interaction Request",PSSCQPMM=2:"Transmit Drug Interaction Severity Change Request",PSSCQPMM=3:"Transmit Duplicate Therapy Change Request",1:"Transmit")
+9 SET DIR("?")=" "
SET DIR("?",1)="Enter 'Y' to transmit this request for review. (For production accounts only)"
+10 SET DIR("?",2)="If you enter 'N', the message will sent to you only, in Vista mail."
SET DIR("?",3)="Enter '^' to exit, and not send the message."
+11 DO ^DIR
KILL DIR
+12 IF $DATA(DUOUT)!($DATA(DTOUT))
SET PSSCQOUT=1
QUIT
+13 SET PSSCQVIS=0
+14 IF Y'=1
SET PSSCQVIS=1
DO SEND(PSSCQPMM)
WRITE !!,"Mail message only sent to you in Vista Mail.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
QUIT
+15 DO SEND(PSSCQPMM)
WRITE !!,"Mail message transmitted for review.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+16 QUIT
+17 ;
+18 ;
SEND(PSSCQVAL) ;Send Mail Message
+1 NEW XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMDUN,DIFROM,XMYBLOB,XMZ,PSSCQLP,PSSCQCNT
+2 IF PSSCQVAL=1
DO NDITXT
GOTO PASS
+3 IF PSSCQVAL=2
DO DISCTXT
GOTO PASS
+4 IF PSSCQVAL=3
DO DTCTXT
GOTO PASS
+5 ;DOSING - when Dosing comes out, uncomment next line
+6 IF PSSCQVAL=4
DO DCTXT
PASS ;
+1 SET XMSUB=$SELECT(PSSCQVAL=1:"New Drug Interaction Request",PSSCQVAL=2:"Drug Interaction Severity Change Request",PSSCQVAL=3:"Duplicate Therapy Change Request",PSSCQVAL=4:"Dosing Change Request",1:"Unknown Request")
+2 ;DOSING - when Dosing comes out, remove next line and uncomment previous line
+3 ;S XMSUB=$S(PSSCQVAL=1:"New Drug Interaction Request",PSSCQVAL=2:"Drug Interaction Severity Change Request",PSSCQVAL=3:"Duplicate Therapy Change Request",1:"Unknown Request")
+4 SET XMDUZ=DUZ
+5 SET XMTEXT="^TMP($J,""PSSCQTXT"","
+6 SET XMY(DUZ)=""
+7 IF 'PSSCQVIS
IF PSSCQCCT
SET XMY("VAOITVHITPSCUSTOMREQ@domain.ext")=""
+8 DO ^XMD
+9 QUIT
+10 ;
+11 ;
NDITXT ;Format text message for New Drug Interaction
+1 SET ^TMP($JOB,"PSSCQTXT",1,0)="Request New Drug Interaction:"
+2 SET ^TMP($JOB,"PSSCQTXT",2,0)=$GET(PSSCQNDD)
+3 SET ^TMP($JOB,"PSSCQTXT",3,0)=" "
+4 SET ^TMP($JOB,"PSSCQTXT",4,0)="Severity:"
+5 SET ^TMP($JOB,"PSSCQTXT",5,0)=$SELECT($GET(PSSCQNSV)=1:"CRITICAL",$GET(PSSCQNSV)=2:"SIGNIFICANT",1:"UNKNOWN")
+6 SET ^TMP($JOB,"PSSCQTXT",6,0)=" "
+7 SET PSSCQCNT=7
+8 FOR PSSCQLP=0:0
SET PSSCQLP=$ORDER(^TMP($JOB,"PSSCQWP",PSSCQLP))
if 'PSSCQLP
QUIT
SET ^TMP($JOB,"PSSCQTXT",PSSCQCNT,0)=$GET(^TMP($JOB,"PSSCQWP",PSSCQLP,0))
SET PSSCQCNT=PSSCQCNT+1
+9 QUIT
+10 ;
+11 ;
DISCTXT ;Format text message for Drug Interaction Severity Change
+1 SET ^TMP($JOB,"PSSCQTXT",1,0)="Drug-Drug Interaction:"
+2 SET ^TMP($JOB,"PSSCQTXT",2,0)=$GET(PSSCQSDD)
+3 SET ^TMP($JOB,"PSSCQTXT",3,0)=" "
+4 SET ^TMP($JOB,"PSSCQTXT",4,0)="Severity Change To:"
+5 SET ^TMP($JOB,"PSSCQTXT",5,0)=$SELECT($GET(PSSCQSSV)=1:"CRITICAL",$GET(PSSCQSSV)=2:"SIGNIFICANT",1:"UNKNOWN")
+6 SET ^TMP($JOB,"PSSCQTXT",6,0)=" "
+7 SET PSSCQCNT=7
+8 FOR PSSCQLP=0:0
SET PSSCQLP=$ORDER(^TMP($JOB,"PSSCQWP",PSSCQLP))
if 'PSSCQLP
QUIT
SET ^TMP($JOB,"PSSCQTXT",PSSCQCNT,0)=$GET(^TMP($JOB,"PSSCQWP",PSSCQLP,0))
SET PSSCQCNT=PSSCQCNT+1
+9 QUIT
+10 ;
+11 ;
DTCTXT ;Format text message for Duplicate Therapy Change
+1 SET ^TMP($JOB,"PSSCQTXT",1,0)="Duplicate Therapy Change Description/Problem:"
+2 SET ^TMP($JOB,"PSSCQTXT",2,0)=" "
+3 SET PSSCQCNT=3
+4 FOR PSSCQLP=0:0
SET PSSCQLP=$ORDER(^TMP($JOB,"PSSCQWP",PSSCQLP))
if 'PSSCQLP
QUIT
SET ^TMP($JOB,"PSSCQTXT",PSSCQCNT,0)=$GET(^TMP($JOB,"PSSCQWP",PSSCQLP,0))
SET PSSCQCNT=PSSCQCNT+1
+5 QUIT
+6 ;
+7 ;
DCTXT ;Format text message for Dosing Change
+1 ;DOSING - Should never be called until Dosing comes out. When Dosing does come out, remove next line (Quit)
+2 ;Q
+3 SET ^TMP($JOB,"PSSCQTXT",1,0)="Dosing Change Description/Problem:"
+4 SET ^TMP($JOB,"PSSCQTXT",2,0)=" "
+5 SET PSSCQCNT=3
+6 FOR PSSCQLP=0:0
SET PSSCQLP=$ORDER(^TMP($JOB,"PSSCQWP",PSSCQLP))
if 'PSSCQLP
QUIT
SET ^TMP($JOB,"PSSCQTXT",PSSCQCNT,0)=$GET(^TMP($JOB,"PSSCQWP",PSSCQLP,0))
SET PSSCQCNT=PSSCQCNT+1
+7 QUIT
+8 ;
+9 ;
KLWRD ;
+1 KILL DDWAUTO,DDWTAB,DWDISABL,DIWEPSE,DIWETXT,DDWLMAR,DDWRMAR,DDWRW,DDWC,DDWFLAGS,DIWESUB,DWLW,DWPK,DIC
+2 KILL ^TMP($JOB,"PSSCQWP")
+3 QUIT
