PSSDSONF ;BIR/RTR-Dosing On/Off Parameter ;07/09/12
;;1.0;PHARMACY DATA MANAGEMENT;**160**;9/30/97;Build 76
;
EN ;Turn Dosing On and Off
N PSSDONA,PSSDONLK,PSSDONR,PSSDONTS,DIC,DIE,DA,DR,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S PSSDONA=$P($G(^PS(59.7,1,81)),"^"),PSSDONTS=1 I '$$PROD^XUPROD S PSSDONTS=0
W !!?5,$S(PSSDONA:"Dosing Order Checks are currently ENABLED.",1:"WARNING! Dosing Order Checks are currently DISABLED.")
I PSSDONA G ON
W !!,"No Dosing Order Checks will be performed during order entry in CPRS or",!,"Pharmacy while Dosing Order Checks are disabled!!!"
D LCK I 'PSSDONLK D END Q
W ! K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you wish to ENABLE Dosing Order Checks"
S DIR("?",1)="Enter 'YES' to enable all Dosing Order Checks for Outpatient Pharmacy,"
S DIR("?")="Inpatient Medications and Computerized Patient Record System (CPRS)."
D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) W !!?5,"WARNING! Dosing Order Checks remain DISABLED." D D UNLCK,END Q
.W !!,"NO Dosing Order Checks will be performed during order entry in CPRS",!,"or Pharmacy while Dosing Order Checks are disabled!!!"
K PSSDONR K ^TMP("DIERR",$J) S PSSDONR(59.7,"1,",95)=1 D FILE^DIE("","PSSDONR") K ^TMP("DIERR",$J)
I '$P($G(^PS(59.7,1,81)),"^") W !!?5,"UNABLE to enable Dosing Order Checks! Please contact",!?5,"local support for assistance." D UNLCK,END Q
W !!?5,"Dosing Order Checks ENABLED.",! D TMES
D SEND(1,0),SEND(1,1) D UNLCK,END Q
Q
;
;
ON ;
D LCK I 'PSSDONLK D END Q
W ! K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you wish to DISABLE Dosing Order Checks"
S DIR("?",1)="Enter 'YES' to disable all Dosing Order Checks for Outpatient Pharmacy,"
S DIR("?")="Inpatient Medications and CPRS."
D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) W !!?5,"Dosing Order Checks remain ENABLED." D UNLCK,END Q
W ! K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="NO",DIR("A")="to take this action"
S DIR("A",1)="Have you received authorization from Pharmacy Benefits Management (PBM)"
S DIR("?",1)="To turn Dosing Off, authorization must first come from Pharmacy",DIR("?")="Benefits Management (PBM)."
D ^DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) W !!?5,"Dosing Order Checks remain ENABLED." D UNLCK,END Q
W !!,"NO Dosing Order Checks will be performed during order entry in CPRS"
W !,"or Pharmacy while Dosing Order Checks are disabled!!!",!!,"Notification of this action will be sent to PBM and local VistA"
W !,"PSS ORDER CHECKS mail group."
W ! K DIR,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="NO",DIR("A")="Are you sure you want to DISABLE Dosing Order Checks"
S DIR("?",1)="Enter 'YES' to disable all Dosing Order Checks for Outpatient Pharmacy,"
S DIR("?")="Inpatient Medications and CPRS."
D ^DIR K DIR I Y'=1!($D(DTOUT))!($D(DUOUT)) W !!?5,"Dosing Order Checks remain ENABLED." D UNLCK,END Q
K PSSDONR K ^TMP("DIERR",$J) S PSSDONR(59.7,"1,",95)=0 D FILE^DIE("","PSSDONR") K ^TMP("DIERR",$J)
I $P($G(^PS(59.7,1,81)),"^") W !!?5,"UNABLE to disable Dosing Order Checks! Please contact",!?5,"local support for assistance." D UNLCK,END Q
W !!?5,"Dosing Order Checks DISABLED.",! D TMES
D SEND(0,0),SEND(0,1) D UNLCK,END Q
Q
;
;
TMES ;Write final message
I 'PSSDONTS W !,"Note: This is a TEST account. This request will NOT be sent forward to PBM",!,"on Outlook mail." Q
W !,"NOTIFICATION OF THIS ACTION has been forwarded to PBM and local",!,"VistA PSS ORDER CHECKS mail group."
Q
;
;
SEND(PSSDONW,PSSDONAB) ;Send mail message
I 'PSSDONTS,PSSDONAB Q
N XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMDUN,DIFROM,XMYBLOB,XMZ,X,Y,%,%H,%I,%DT,PSSDONSC,PSSDONLC,PSSDONDZ
S XMSUB="DOSING ORDER CHECKS "_$S(PSSDONW:"ENABLED",1:"DISABLED")
S XMDUZ=DUZ
D NOW^%DTC S Y=%,%DT="S" D DD^%DT S PSSDONSC=Y
S PSSDONLC=$P($$SITE^VASITE(),"^",2)
S PSSDONDZ=$$GET1^DIQ(200,DUZ_",",.01)
K ^TMP($J,"PSSDSOTX")
I PSSDONAB D
.S ^TMP($J,"PSSDSOTX",1,0)=$G(PSSDONDZ)_" from "_$G(PSSDONLC)
.S ^TMP($J,"PSSDSOTX",2,0)="has "_$S(PSSDONW:"ENABLED",1:"DISABLED")_" Dosing Order Checks on "_$G(PSSDONSC)_"."
I 'PSSDONAB D
.S ^TMP($J,"PSSDSOTX",1,0)=$G(PSSDONDZ)_" has "_$S(PSSDONW:"ENABLED",1:"DISABLED")_" Dosing Order Checks on "_$G(PSSDONSC)_"."
S XMTEXT="^TMP($J,""PSSDSOTX"","
I 'PSSDONAB D
.S XMY(DUZ)=""
.S XMY("G.PSS ORDER CHECKS")=""
I PSSDONTS,PSSDONAB S XMY("MOCHADOSINGDISCONNECTNOTIFY@domain.ext")=""
D ^XMD
K ^TMP($J,"PSSDSOTX")
Q
;
;
LCK ;Lock node
S PSSDONLK=0 L +^PS(59.7,1,81):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T W !!,"Another person is editing the Dosing On/Off Switch." Q
S PSSDONLK=1
Q
;
;
UNLCK ;Unlock node
L -^PS(59.7,1,81)
Q
;
;
END ;
K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR W !
Q
;
;
ACLOG ;Set activity log multiple for DOSING ON/OFF switch.
I $G(X1(1))=$G(X2(1)) Q
N PSSDHAH,PSSDHAHX,%,%H,%I,X
S PSSDHAH("DA")=DA
D NOW^%DTC S PSSDHAHX(59.782,"+1,"_PSSDHAH("DA")_",",.01)=%
S PSSDHAHX(59.782,"+1,"_PSSDHAH("DA")_",",1)=$G(DUZ)
S PSSDHAHX(59.782,"+1,"_PSSDHAH("DA")_",",2)=$G(X2(1))
K ^TMP("DIERR",$J)
D UPDATE^DIE("","PSSDHAHX")
K ^TMP("DIERR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSONF 5160 printed Sep 23, 2025@20:07:02 Page 2
PSSDSONF ;BIR/RTR-Dosing On/Off Parameter ;07/09/12
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**160**;9/30/97;Build 76
+2 ;
EN ;Turn Dosing On and Off
+1 NEW PSSDONA,PSSDONLK,PSSDONR,PSSDONTS,DIC,DIE,DA,DR,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 SET PSSDONA=$PIECE($GET(^PS(59.7,1,81)),"^")
SET PSSDONTS=1
IF '$$PROD^XUPROD
SET PSSDONTS=0
+3 WRITE !!?5,$SELECT(PSSDONA:"Dosing Order Checks are currently ENABLED.",1:"WARNING! Dosing Order Checks are currently DISABLED.")
+4 IF PSSDONA
GOTO ON
+5 WRITE !!,"No Dosing Order Checks will be performed during order entry in CPRS or",!,"Pharmacy while Dosing Order Checks are disabled!!!"
+6 DO LCK
IF 'PSSDONLK
DO END
QUIT
+7 WRITE !
KILL DIR,DTOUT,DUOUT
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Do you wish to ENABLE Dosing Order Checks"
+8 SET DIR("?",1)="Enter 'YES' to enable all Dosing Order Checks for Outpatient Pharmacy,"
+9 SET DIR("?")="Inpatient Medications and Computerized Patient Record System (CPRS)."
+10 DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!?5,"WARNING! Dosing Order Checks remain DISABLED."
Begin DoDot:1
+11 WRITE !!,"NO Dosing Order Checks will be performed during order entry in CPRS",!,"or Pharmacy while Dosing Order Checks are disabled!!!"
End DoDot:1
DO UNLCK
DO END
QUIT
+12 KILL PSSDONR
KILL ^TMP("DIERR",$JOB)
SET PSSDONR(59.7,"1,",95)=1
DO FILE^DIE("","PSSDONR")
KILL ^TMP("DIERR",$JOB)
+13 IF '$PIECE($GET(^PS(59.7,1,81)),"^")
WRITE !!?5,"UNABLE to enable Dosing Order Checks! Please contact",!?5,"local support for assistance."
DO UNLCK
DO END
QUIT
+14 WRITE !!?5,"Dosing Order Checks ENABLED.",!
DO TMES
+15 DO SEND(1,0)
DO SEND(1,1)
DO UNLCK
DO END
QUIT
+16 QUIT
+17 ;
+18 ;
ON ;
+1 DO LCK
IF 'PSSDONLK
DO END
QUIT
+2 WRITE !
KILL DIR,DTOUT,DUOUT
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you wish to DISABLE Dosing Order Checks"
+3 SET DIR("?",1)="Enter 'YES' to disable all Dosing Order Checks for Outpatient Pharmacy,"
+4 SET DIR("?")="Inpatient Medications and CPRS."
+5 DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!?5,"Dosing Order Checks remain ENABLED."
DO UNLCK
DO END
QUIT
+6 WRITE !
KILL DIR,DTOUT,DUOUT
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="to take this action"
+7 SET DIR("A",1)="Have you received authorization from Pharmacy Benefits Management (PBM)"
+8 SET DIR("?",1)="To turn Dosing Off, authorization must first come from Pharmacy"
SET DIR("?")="Benefits Management (PBM)."
+9 DO ^DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!?5,"Dosing Order Checks remain ENABLED."
DO UNLCK
DO END
QUIT
+10 WRITE !!,"NO Dosing Order Checks will be performed during order entry in CPRS"
+11 WRITE !,"or Pharmacy while Dosing Order Checks are disabled!!!",!!,"Notification of this action will be sent to PBM and local VistA"
+12 WRITE !,"PSS ORDER CHECKS mail group."
+13 WRITE !
KILL DIR,DTOUT,DUOUT
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Are you sure you want to DISABLE Dosing Order Checks"
+14 SET DIR("?",1)="Enter 'YES' to disable all Dosing Order Checks for Outpatient Pharmacy,"
+15 SET DIR("?")="Inpatient Medications and CPRS."
+16 DO ^DIR
KILL DIR
IF Y'=1!($DATA(DTOUT))!($DATA(DUOUT))
WRITE !!?5,"Dosing Order Checks remain ENABLED."
DO UNLCK
DO END
QUIT
+17 KILL PSSDONR
KILL ^TMP("DIERR",$JOB)
SET PSSDONR(59.7,"1,",95)=0
DO FILE^DIE("","PSSDONR")
KILL ^TMP("DIERR",$JOB)
+18 IF $PIECE($GET(^PS(59.7,1,81)),"^")
WRITE !!?5,"UNABLE to disable Dosing Order Checks! Please contact",!?5,"local support for assistance."
DO UNLCK
DO END
QUIT
+19 WRITE !!?5,"Dosing Order Checks DISABLED.",!
DO TMES
+20 DO SEND(0,0)
DO SEND(0,1)
DO UNLCK
DO END
QUIT
+21 QUIT
+22 ;
+23 ;
TMES ;Write final message
+1 IF 'PSSDONTS
WRITE !,"Note: This is a TEST account. This request will NOT be sent forward to PBM",!,"on Outlook mail."
QUIT
+2 WRITE !,"NOTIFICATION OF THIS ACTION has been forwarded to PBM and local",!,"VistA PSS ORDER CHECKS mail group."
+3 QUIT
+4 ;
+5 ;
SEND(PSSDONW,PSSDONAB) ;Send mail message
+1 IF 'PSSDONTS
IF PSSDONAB
QUIT
+2 NEW XMTEXT,XMY,XMSUB,XMDUZ,XMMG,XMSTRIP,XMROU,XMDUN,DIFROM,XMYBLOB,XMZ,X,Y,%,%H,%I,%DT,PSSDONSC,PSSDONLC,PSSDONDZ
+3 SET XMSUB="DOSING ORDER CHECKS "_$SELECT(PSSDONW:"ENABLED",1:"DISABLED")
+4 SET XMDUZ=DUZ
+5 DO NOW^%DTC
SET Y=%
SET %DT="S"
DO DD^%DT
SET PSSDONSC=Y
+6 SET PSSDONLC=$PIECE($$SITE^VASITE(),"^",2)
+7 SET PSSDONDZ=$$GET1^DIQ(200,DUZ_",",.01)
+8 KILL ^TMP($JOB,"PSSDSOTX")
+9 IF PSSDONAB
Begin DoDot:1
+10 SET ^TMP($JOB,"PSSDSOTX",1,0)=$GET(PSSDONDZ)_" from "_$GET(PSSDONLC)
+11 SET ^TMP($JOB,"PSSDSOTX",2,0)="has "_$SELECT(PSSDONW:"ENABLED",1:"DISABLED")_" Dosing Order Checks on "_$GET(PSSDONSC)_"."
End DoDot:1
+12 IF 'PSSDONAB
Begin DoDot:1
+13 SET ^TMP($JOB,"PSSDSOTX",1,0)=$GET(PSSDONDZ)_" has "_$SELECT(PSSDONW:"ENABLED",1:"DISABLED")_" Dosing Order Checks on "_$GET(PSSDONSC)_"."
End DoDot:1
+14 SET XMTEXT="^TMP($J,""PSSDSOTX"","
+15 IF 'PSSDONAB
Begin DoDot:1
+16 SET XMY(DUZ)=""
+17 SET XMY("G.PSS ORDER CHECKS")=""
End DoDot:1
+18 IF PSSDONTS
IF PSSDONAB
SET XMY("MOCHADOSINGDISCONNECTNOTIFY@domain.ext")=""
+19 DO ^XMD
+20 KILL ^TMP($JOB,"PSSDSOTX")
+21 QUIT
+22 ;
+23 ;
LCK ;Lock node
+1 SET PSSDONLK=0
LOCK +^PS(59.7,1,81):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF '$TEST
WRITE !!,"Another person is editing the Dosing On/Off Switch."
QUIT
+2 SET PSSDONLK=1
+3 QUIT
+4 ;
+5 ;
UNLCK ;Unlock node
+1 LOCK -^PS(59.7,1,81)
+2 QUIT
+3 ;
+4 ;
END ;
+1 KILL DIR
WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
WRITE !
+2 QUIT
+3 ;
+4 ;
ACLOG ;Set activity log multiple for DOSING ON/OFF switch.
+1 IF $GET(X1(1))=$GET(X2(1))
QUIT
+2 NEW PSSDHAH,PSSDHAHX,%,%H,%I,X
+3 SET PSSDHAH("DA")=DA
+4 DO NOW^%DTC
SET PSSDHAHX(59.782,"+1,"_PSSDHAH("DA")_",",.01)=%
+5 SET PSSDHAHX(59.782,"+1,"_PSSDHAH("DA")_",",1)=$GET(DUZ)
+6 SET PSSDHAHX(59.782,"+1,"_PSSDHAH("DA")_",",2)=$GET(X2(1))
+7 KILL ^TMP("DIERR",$JOB)
+8 DO UPDATE^DIE("","PSSDHAHX")
+9 KILL ^TMP("DIERR",$JOB)
+10 QUIT
