- 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 Feb 18, 2025@23:56:39 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