Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSSCUSRQ

PSSCUSRQ.m

Go to the documentation of this file.
  1. PSSCUSRQ ;BIR/RTR-Request Customization changes ;04/01/09
  1. ;;1.0;PHARMACY DATA MANAGEMENT;**117**;9/30/97;Build 101
  1. ;
  1. ;Request customization changes
  1. ;
  1. EN ;
  1. N DDWAUTO,DDWTAB,DWDISABL,DIWEPSE,DIWETXT,DDWLMAR,DDWRMAR,DDWRW,DDWC,DDWFLAGS,DIWESUB,DWLW,DWPK
  1. N J,%,D0,D1,D2,DG,DIC,DIR,X,Y,DUOUT,DTOUT,DIRUT,DIROUT
  1. N PSSCQOUT,PSSCQANS,PSSCQPRM,PSSCQPMM,PSSCQVIS,PSSCQVAL,PSSCQCCT
  1. S PSSCQOUT=0
  1. 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"
  1. S DIR("?")=" ",DIR("?",1)="Enter 'N' to request that a new Drug/Drug interaction be added, enter 'S' to"
  1. 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."
  1. ;DOSING - When Dosing comes out, uncomment previous 3 lines, delete next 3 lines
  1. ;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"
  1. ;S DIR("?")=" ",DIR("?",1)="Enter 'N' to request that a new Drug/Drug interaction be added, enter 'S' to"
  1. ;S DIR("?",2)="request a severity change to an existing Drug/Drug interaction, enter 'T' to",DIR("?",3)="request a Duplicate Therapy change."
  1. D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
  1. I Y'="N",Y'="S",Y'="T",Y'="D" D MESS Q
  1. ;DOSING - When Dosing comes out, uncomment previous line, delete next line
  1. ;I Y'="N",Y'="S",Y'="T" D MESS Q
  1. S PSSCQANS=Y
  1. D FIN
  1. I PSSCQANS="N" D NDI D FIN D:PSSCQOUT MESS Q
  1. I PSSCQANS="S" D DISC D FIN D:PSSCQOUT MESS Q
  1. I PSSCQANS="T" D DTC D FIN D:PSSCQOUT MESS Q
  1. ;DOSING - Uncomment next line when Dosing comes out
  1. I PSSCQANS="D" D DC D FIN D:PSSCQOUT MESS
  1. Q
  1. ;
  1. ;
  1. MESS ;Exit Message
  1. W !!,"No Action Taken.",!
  1. K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. Q
  1. ;
  1. ;
  1. NDI ;New Drug Interaction
  1. N PSSCQNDD,PSSCQNSV
  1. 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"
  1. S DIR("?",2)="that you are requesting, 1 to 78 characters."
  1. D ^DIR K DIR I $D(DIRUT)!($D(DUOUT))!($D(DTOUT)) S PSSCQOUT=1 Q
  1. S PSSCQNDD=Y
  1. ;
  1. K DIR,Y S DIR(0)="SO^1:Critical;2:Significant",DIR("A")="Enter Severity"
  1. S DIR("?")=" ",DIR("?",1)="Enter '1' to request that this new Drug/Drug interaction be classified"
  1. S DIR("?",2)="as Critical, enter '2' to request it be classified as Significant."
  1. D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S PSSCQOUT=1 Q
  1. I Y'=1,Y'=2 S PSSCQOUT=1 Q
  1. S PSSCQNSV=Y
  1. ;
  1. W !!,"You must now enter a reason or references for this request. <word processing>",!
  1. 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
  1. W ! D KLWRD S DIWESUB="References/Reason for Request",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
  1. I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
  1. ;
  1. W ! S PSSCQPRM=1 D TEST(PSSCQPRM)
  1. Q
  1. ;
  1. ;
  1. DISC ;Drug Interaction Severity Change
  1. N PSSCQSDD,PSSCQSSV
  1. 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"
  1. S DIR("?",2)="would like to see the severity changed for, 1 to 78 characters."
  1. D ^DIR K DIR I $D(DIRUT)!($D(DUOUT))!($D(DTOUT)) S PSSCQOUT=1 Q
  1. S PSSCQSDD=Y
  1. ;
  1. K DIR,Y S DIR(0)="SO^1:Critical;2:Significant",DIR("A")="Change Severity To"
  1. S DIR("?")=" ",DIR("?",1)="Enter '1' to request that this Drug/Drug interaction severity be changed"
  1. S DIR("?",2)="to Critical, enter '2' to request it be changed to Significant."
  1. D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S PSSCQOUT=1 Q
  1. I Y'=1,Y'=2 S PSSCQOUT=1 Q
  1. S PSSCQSSV=Y
  1. ;
  1. W !!,"You must now enter a reason or references for this request. <word processing>",!
  1. 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
  1. W ! D KLWRD S DIWESUB="References/Reason for Request",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
  1. I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
  1. ;
  1. W ! S PSSCQPRM=2 D TEST(PSSCQPRM)
  1. Q
  1. ;
  1. ;
  1. DTC ;Duplicate Therapy Change
  1. W !!,"You must now enter a description of the change/problem. <word processing>",!
  1. K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSCQOUT=1 Q
  1. W ! D KLWRD S DIWESUB="Description of change/problem",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
  1. I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
  1. ;
  1. W ! S PSSCQPRM=3 D TEST(PSSCQPRM)
  1. Q
  1. ;
  1. ;
  1. DC ;Dosing Change
  1. ;DOSING - This code should never be called until Dosing comes out, when it does remove next line (Quit)
  1. ;Q
  1. W !!,"You must now enter a description of the change/problem. <word processing>",!
  1. K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSCQOUT=1 Q
  1. W ! D KLWRD S DIWESUB="Description of change/problem",DWLW=78,DWPK=1,DIC="^TMP($J,""PSSCQWP""," D EN^DIWE
  1. I '$D(^TMP($J,"PSSCQWP")) W !!,"No data was entered." S PSSCQOUT=1 Q
  1. ;
  1. W ! S PSSCQPRM=4 D TEST(PSSCQPRM)
  1. Q
  1. ;
  1. ;
  1. FIN ;Clean Up
  1. K ^TMP($J,"PSSCQTXT")
  1. K ^TMP($J,"PSSCQWP")
  1. Q
  1. ;
  1. ;
  1. TEST(PSSCQPMM) ;Prompt to send Mail Message
  1. ;For Dosing, add a check for 4 in the next line
  1. I PSSCQPMM'=1,PSSCQPMM'=2,PSSCQPMM'=3,PSSCQPMM'=4 W !!,"Problem with option, please enter a Remedy ticket." S PSSCQOUT=1 Q
  1. S PSSCQCCT=1
  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.",!
  1. K DIR,Y S DIR(0)="Y",DIR("B")="Y"
  1. 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")
  1. ;DOSING - when dosing comes out, remove next line and uncomment previous line
  1. ;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")
  1. S DIR("?")=" ",DIR("?",1)="Enter 'Y' to transmit this request for review. (For production accounts only)"
  1. 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."
  1. D ^DIR K DIR
  1. I $D(DUOUT)!($D(DTOUT)) S PSSCQOUT=1 Q
  1. S PSSCQVIS=0
  1. 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
  1. 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
  1. Q
  1. ;
  1. ;
  1. SEND(PSSCQVAL) ;Send Mail Message
  1. N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMDUN,DIFROM,XMYBLOB,XMZ,PSSCQLP,PSSCQCNT
  1. I PSSCQVAL=1 D NDITXT G PASS
  1. I PSSCQVAL=2 D DISCTXT G PASS
  1. I PSSCQVAL=3 D DTCTXT G PASS
  1. ;DOSING - when Dosing comes out, uncomment next line
  1. I PSSCQVAL=4 D DCTXT
  1. PASS ;
  1. 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")
  1. ;DOSING - when Dosing comes out, remove next line and uncomment previous line
  1. ;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")
  1. S XMDUZ=DUZ
  1. S XMTEXT="^TMP($J,""PSSCQTXT"","
  1. S XMY(DUZ)=""
  1. I 'PSSCQVIS,PSSCQCCT S XMY("VAOITVHITPSCUSTOMREQ@domain.ext")=""
  1. D ^XMD
  1. Q
  1. ;
  1. ;
  1. NDITXT ;Format text message for New Drug Interaction
  1. S ^TMP($J,"PSSCQTXT",1,0)="Request New Drug Interaction:"
  1. S ^TMP($J,"PSSCQTXT",2,0)=$G(PSSCQNDD)
  1. S ^TMP($J,"PSSCQTXT",3,0)=" "
  1. S ^TMP($J,"PSSCQTXT",4,0)="Severity:"
  1. S ^TMP($J,"PSSCQTXT",5,0)=$S($G(PSSCQNSV)=1:"CRITICAL",$G(PSSCQNSV)=2:"SIGNIFICANT",1:"UNKNOWN")
  1. S ^TMP($J,"PSSCQTXT",6,0)=" "
  1. S PSSCQCNT=7
  1. 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
  1. Q
  1. ;
  1. ;
  1. DISCTXT ;Format text message for Drug Interaction Severity Change
  1. S ^TMP($J,"PSSCQTXT",1,0)="Drug-Drug Interaction:"
  1. S ^TMP($J,"PSSCQTXT",2,0)=$G(PSSCQSDD)
  1. S ^TMP($J,"PSSCQTXT",3,0)=" "
  1. S ^TMP($J,"PSSCQTXT",4,0)="Severity Change To:"
  1. S ^TMP($J,"PSSCQTXT",5,0)=$S($G(PSSCQSSV)=1:"CRITICAL",$G(PSSCQSSV)=2:"SIGNIFICANT",1:"UNKNOWN")
  1. S ^TMP($J,"PSSCQTXT",6,0)=" "
  1. S PSSCQCNT=7
  1. 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
  1. Q
  1. ;
  1. ;
  1. DTCTXT ;Format text message for Duplicate Therapy Change
  1. S ^TMP($J,"PSSCQTXT",1,0)="Duplicate Therapy Change Description/Problem:"
  1. S ^TMP($J,"PSSCQTXT",2,0)=" "
  1. S PSSCQCNT=3
  1. 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
  1. Q
  1. ;
  1. ;
  1. 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)
  1. ;Q
  1. S ^TMP($J,"PSSCQTXT",1,0)="Dosing Change Description/Problem:"
  1. S ^TMP($J,"PSSCQTXT",2,0)=" "
  1. S PSSCQCNT=3
  1. 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
  1. Q
  1. ;
  1. ;
  1. KLWRD ;
  1. K DDWAUTO,DDWTAB,DWDISABL,DIWEPSE,DIWETXT,DDWLMAR,DDWRMAR,DDWRW,DDWC,DDWFLAGS,DIWESUB,DWLW,DWPK,DIC
  1. K ^TMP($J,"PSSCQWP")
  1. Q