ORB3MGR2 ; SLC/AEB - Utilities for Manager Options - Notifications Parameters ;4/23/96 16:53
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,85,105**;Dec 17, 1997
;
USERDEL ; Purge undesired alerts/notifications for a user
N ORBDUZ,XQ1
W !!,"This option purges an existing alert/notification for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
UDEL2 D USERDEL^XQALERT
Q
RECIPURG ; Purge existing alerts/notifications for a user
N ORBDUZ,XQ1
W !!,"This option purges all existing alerts/notifications for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
; Get user DUZ number
K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
S ^TMP("ORB",$J,"ORBDUZ")=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
S ORBDUZ=^TMP("ORB",$J,"ORBDUZ")
S XQ1=$S($D(^TMP("ORB",$J,"ORBDUZ")):^TMP("ORB",$J,"ORBDUZ"),1:DUZ)
W !!,$C(7),"Do you want to purge all alerts/notifications for ",$P(^VA(200,XQ1,0),"^") S %=2 D YN^DICN D
.I %=0 W !,"Enter 'YES' if you want to purge all existing alerts for this person.",!,"Do you want to purge all notifications for this recipient" S %=2 D YN^DICN
Q:%'=1 W !!,"Purging alerts/notifications...",!
K %
D RECIPURG^XQALBUTL(XQ1)
K ^TMP("ORB",$J)
Q
PTPURG ; Purge existing alerts/notifications for a patient
W !!,"This option purges all existing alerts/notifications for a patient.",!?5,"*** USE WITH CAUTION ***"
K DIC S DIC="^DPT(",DIC(0)="AENQM",DIC("A")="Enter alert/notification patient's name: " D ^DIC Q:Y<1
K DIC,DUOUT,DTOUT
W !!,$C(7),"Do you want to purge all alerts/notifications for patient ",$P(Y,"^",2),"?" S %=2 D YN^DICN Q:%'=1 W !!,"Purging alerts/notifications...",!
K %
D PTPURG^XQALBUTL(+Y)
K Y
Q
NOTIPURG ; Purge all instances of a notification
W !!,"This option purges all existing instances of a notification.",!?5,"*** USE WITH CAUTION ***"
K DIC S DIC="^ORD(100.9,",DIC(0)="AENQ",DIC("A")="Enter notification name: " D ^DIC Q:Y<1
K DIC,DUOUT,DTOUT
W !!,$C(7),"Do you want to purge all instances of notification ",$P(Y,"^",2),"?" S %=2 D YN^DICN Q:%'=1 W !!,"Purging all instances of this notification...",!
K %
D NOTIPURG^XQALBUTL(+Y)
K Y
Q
ERASEALL ; Edit ORB ERASE ALL parameter for a User
N PIEN
S PIEN=0,PIEN=$O(^XTV(8989.51,"B","ORB ERASE ALL",PIEN)) Q:PIEN=""
D TITLE^ORB3MGR1("Set User's Ability to Erase All His Notifications/Alerts")
D PROC^ORB3MGR1(PIEN)
Q
USRNOTS ; List notifications a user could receive
N ORBUSR
; Get user DUZ number
K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
S ORBUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
D USRNOTS^ORB3U2(ORBUSR)
Q
LABTHRES ; set lab threshold parameter for user
N ORBT,ORBLAB,ORBSP,ORBTHRES,ORBERR,DIC,DIR,Y
N ORBUSR,ORBGL,ORBLABN,ORBSPN
;
W !,$C(7),"Do you want to add, modify or remove lab thresholds" S %=1 D YN^DICN D
.I %=0 W !,"Enter 'YES' if you want to add, modify or remove lab thresholds for alerts.",!,"(Enter '0' (zero) at the THRESHOLD prompt to remove a threshold.)",!,"Do you want to add, modify or remove lab thresholds" S %=1 D YN^DICN
Q:%'=1 K %
;
F D Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
.W !
.S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name (""^"" to exit): "
.S DIC("B")=$S($G(ORBUSR):ORBUSR,1:DUZ) D ^DIC Q:Y<1
.S ORBUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
.;
.D DISPTHR(ORBUSR,">")
.D DISPTHR(ORBUSR,"<")
.W !
.;
.;get Lab test:
.S DIC=60,DIC(0)="AEMQ",DIC("A")="Select LAB TEST: " D ^DIC K DIC Q:Y<1
.S ORBLAB=+Y,ORBLABN=$P(Y,U,2)
.;
.;get test Specimen:
.S DIC=61,DIC(0)="AEMQ",DIC("A")="Select SPECIMEN: " D ^DIC K DIC Q:Y<1
.S ORBSP=+Y,ORBSPN=$P(Y,U,2)
.;
.S ORBLABSP=ORBLAB_";"_ORBSP
.;
.;get greater than or less than:
.K DIR S DIR(0)="SO^>:Greater Than;<:Less Than",DIR("A")="Operator on Lab Value: "
.S DIR("?")="Enter '>' to be alerted for results GREATER than the lab value or '<' to be alerted for results LESS than the lab value."
.D ^DIR K DIR Q:$D(DIRUT)
.S ORBGL=Y
.;
.;get threshold value:
.K DIR S DIR(0)="NA^::4",DIR("A")="Enter THRESHOLD: ",DIR("?")="Enter numeric threshold value. Results above/below this value will send alert. Enter '0' (zero) to remove a threshold."
.D ^DIR K DIR Q:$D(DIRUT)
.S ORBTHRES=Y
.;
.I $G(ORBTHRES)=0 D
..W !,"Removing "_ORBGL_" threshold for "_ORBLABN_" "_ORBSPN_"..."
..D DEL^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,.ORBERR)
..I ORBERR W !,"Error removing lab threshold: ",$P(ORBERR,U,2)
.I $G(ORBTHRES)>0 D
..D EN^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,ORBTHRES,.ORBERR)
..I ORBERR W !,"Error adding lab threshold: ",$P(ORBERR,U,2)
.;
.D DISPTHR(ORBUSR,ORBGL)
;I $L($G(ORBGL)),('$D(DIRUT)) D DISPTHR(ORBUSR,ORBGL)
Q
DISPTHR(ORBUSR,ORBGL) ;display uer's ORB LAB THRESHOLD parameter values
N ORBT,ORBA,ORBLAB,ORBLABN,ORBSP,ORBSPN
D GETLST^XPAR(.ORBT,"USR.`"_ORBUSR,"ORB LAB "_ORBGL_" THRESHOLD","I")
Q:+$G(ORBT)<1
W !!,"Current "_ORBGL_" lab thresholds for ",$$GET1^DIQ(200,ORBUSR_",",.01),":"
S ORBLAB="" F S ORBLAB=$O(ORBT(ORBLAB)) Q:ORBLAB="" D
.S ORBSP=$P(ORBLAB,";",2)
.S ORBLABN=$P(^LAB(60,+ORBLAB,0),U)
.S ORBSPN=$P(^LAB(61,ORBSP,0),U)
.S ORBA(ORBLABN,ORBSPN)=ORBT(ORBLAB)
S ORBLABN="" F S ORBLABN=$O(ORBA(ORBLABN)) Q:ORBLABN="" D
.S ORBSPN="" F S ORBSPN=$O(ORBA(ORBLABN,ORBSPN)) Q:ORBSPN="" D
..W !?2,ORBLABN
..W ?40,ORBSPN
..W ?65,ORBA(ORBLABN,ORBSPN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3MGR2 5533 printed Apr 09, 2024@21:41:18 Page 2
ORB3MGR2 ; SLC/AEB - Utilities for Manager Options - Notifications Parameters ;4/23/96 16:53
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,85,105**;Dec 17, 1997
+2 ;
USERDEL ; Purge undesired alerts/notifications for a user
+1 NEW ORBDUZ,XQ1
+2 WRITE !!,"This option purges an existing alert/notification for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
UDEL2 DO USERDEL^XQALERT
+1 QUIT
RECIPURG ; Purge existing alerts/notifications for a user
+1 NEW ORBDUZ,XQ1
+2 WRITE !!,"This option purges all existing alerts/notifications for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
+3 ; Get user DUZ number
+4 KILL DIC,Y
SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("A")="Enter user's name: "
SET DIC("B")=DUZ
DO ^DIC
if Y<1
QUIT
+5 SET ^TMP("ORB",$JOB,"ORBDUZ")=$SELECT(Y'<1:$PIECE(Y,"^"),1:DUZ)
KILL DIC,Y,DUOUT,DTOUT
+6 SET ORBDUZ=^TMP("ORB",$JOB,"ORBDUZ")
+7 SET XQ1=$SELECT($DATA(^TMP("ORB",$JOB,"ORBDUZ")):^TMP("ORB",$JOB,"ORBDUZ"),1:DUZ)
+8 WRITE !!,$CHAR(7),"Do you want to purge all alerts/notifications for ",$PIECE(^VA(200,XQ1,0),"^")
SET %=2
DO YN^DICN
Begin DoDot:1
+9 IF %=0
WRITE !,"Enter 'YES' if you want to purge all existing alerts for this person.",!,"Do you want to purge all notifications for this recipient"
SET %=2
DO YN^DICN
End DoDot:1
+10 if %'=1
QUIT
WRITE !!,"Purging alerts/notifications...",!
+11 KILL %
+12 DO RECIPURG^XQALBUTL(XQ1)
+13 KILL ^TMP("ORB",$JOB)
+14 QUIT
PTPURG ; Purge existing alerts/notifications for a patient
+1 WRITE !!,"This option purges all existing alerts/notifications for a patient.",!?5,"*** USE WITH CAUTION ***"
+2 KILL DIC
SET DIC="^DPT("
SET DIC(0)="AENQM"
SET DIC("A")="Enter alert/notification patient's name: "
DO ^DIC
if Y<1
QUIT
+3 KILL DIC,DUOUT,DTOUT
+4 WRITE !!,$CHAR(7),"Do you want to purge all alerts/notifications for patient ",$PIECE(Y,"^",2),"?"
SET %=2
DO YN^DICN
if %'=1
QUIT
WRITE !!,"Purging alerts/notifications...",!
+5 KILL %
+6 DO PTPURG^XQALBUTL(+Y)
+7 KILL Y
+8 QUIT
NOTIPURG ; Purge all instances of a notification
+1 WRITE !!,"This option purges all existing instances of a notification.",!?5,"*** USE WITH CAUTION ***"
+2 KILL DIC
SET DIC="^ORD(100.9,"
SET DIC(0)="AENQ"
SET DIC("A")="Enter notification name: "
DO ^DIC
if Y<1
QUIT
+3 KILL DIC,DUOUT,DTOUT
+4 WRITE !!,$CHAR(7),"Do you want to purge all instances of notification ",$PIECE(Y,"^",2),"?"
SET %=2
DO YN^DICN
if %'=1
QUIT
WRITE !!,"Purging all instances of this notification...",!
+5 KILL %
+6 DO NOTIPURG^XQALBUTL(+Y)
+7 KILL Y
+8 QUIT
ERASEALL ; Edit ORB ERASE ALL parameter for a User
+1 NEW PIEN
+2 SET PIEN=0
SET PIEN=$ORDER(^XTV(8989.51,"B","ORB ERASE ALL",PIEN))
if PIEN=""
QUIT
+3 DO TITLE^ORB3MGR1("Set User's Ability to Erase All His Notifications/Alerts")
+4 DO PROC^ORB3MGR1(PIEN)
+5 QUIT
USRNOTS ; List notifications a user could receive
+1 NEW ORBUSR
+2 ; Get user DUZ number
+3 KILL DIC,Y
SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("A")="Enter user's name: "
SET DIC("B")=DUZ
DO ^DIC
if Y<1
QUIT
+4 SET ORBUSR=$SELECT(Y'<1:$PIECE(Y,"^"),1:DUZ)
KILL DIC,Y,DUOUT,DTOUT
+5 DO USRNOTS^ORB3U2(ORBUSR)
+6 QUIT
LABTHRES ; set lab threshold parameter for user
+1 NEW ORBT,ORBLAB,ORBSP,ORBTHRES,ORBERR,DIC,DIR,Y
+2 NEW ORBUSR,ORBGL,ORBLABN,ORBSPN
+3 ;
+4 WRITE !,$CHAR(7),"Do you want to add, modify or remove lab thresholds"
SET %=1
DO YN^DICN
Begin DoDot:1
+5 IF %=0
WRITE !,"Enter 'YES' if you want to add, modify or remove lab thresholds for alerts.",!,"(Enter '0' (zero) at the THRESHOLD prompt to remove a threshold.)",!,"Do you want to add, modify or remove lab thresholds"
SET %=1
DO YN^DICN
End DoDot:1
+6 if %'=1
QUIT
KILL %
+7 ;
+8 FOR
Begin DoDot:1
+9 WRITE !
+10 SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("A")="Enter user's name (""^"" to exit): "
+11 SET DIC("B")=$SELECT($GET(ORBUSR):ORBUSR,1:DUZ)
DO ^DIC
if Y<1
QUIT
+12 SET ORBUSR=$SELECT(Y'<1:$PIECE(Y,"^"),1:DUZ)
KILL DIC,Y,DUOUT,DTOUT
+13 ;
+14 DO DISPTHR(ORBUSR,">")
+15 DO DISPTHR(ORBUSR,"<")
+16 WRITE !
+17 ;
+18 ;get Lab test:
+19 SET DIC=60
SET DIC(0)="AEMQ"
SET DIC("A")="Select LAB TEST: "
DO ^DIC
KILL DIC
if Y<1
QUIT
+20 SET ORBLAB=+Y
SET ORBLABN=$PIECE(Y,U,2)
+21 ;
+22 ;get test Specimen:
+23 SET DIC=61
SET DIC(0)="AEMQ"
SET DIC("A")="Select SPECIMEN: "
DO ^DIC
KILL DIC
if Y<1
QUIT
+24 SET ORBSP=+Y
SET ORBSPN=$PIECE(Y,U,2)
+25 ;
+26 SET ORBLABSP=ORBLAB_";"_ORBSP
+27 ;
+28 ;get greater than or less than:
+29 KILL DIR
SET DIR(0)="SO^>:Greater Than;<:Less Than"
SET DIR("A")="Operator on Lab Value: "
+30 SET DIR("?")="Enter '>' to be alerted for results GREATER than the lab value or '<' to be alerted for results LESS than the lab value."
+31 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+32 SET ORBGL=Y
+33 ;
+34 ;get threshold value:
+35 KILL DIR
SET DIR(0)="NA^::4"
SET DIR("A")="Enter THRESHOLD: "
SET DIR("?")="Enter numeric threshold value. Results above/below this value will send alert. Enter '0' (zero) to remove a threshold."
+36 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+37 SET ORBTHRES=Y
+38 ;
+39 IF $GET(ORBTHRES)=0
Begin DoDot:2
+40 WRITE !,"Removing "_ORBGL_" threshold for "_ORBLABN_" "_ORBSPN_"..."
+41 DO DEL^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,.ORBERR)
+42 IF ORBERR
WRITE !,"Error removing lab threshold: ",$PIECE(ORBERR,U,2)
End DoDot:2
+43 IF $GET(ORBTHRES)>0
Begin DoDot:2
+44 DO EN^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,ORBTHRES,.ORBERR)
+45 IF ORBERR
WRITE !,"Error adding lab threshold: ",$PIECE(ORBERR,U,2)
End DoDot:2
+46 ;
+47 DO DISPTHR(ORBUSR,ORBGL)
End DoDot:1
if $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+48 ;I $L($G(ORBGL)),('$D(DIRUT)) D DISPTHR(ORBUSR,ORBGL)
+49 QUIT
DISPTHR(ORBUSR,ORBGL) ;display uer's ORB LAB THRESHOLD parameter values
+1 NEW ORBT,ORBA,ORBLAB,ORBLABN,ORBSP,ORBSPN
+2 DO GETLST^XPAR(.ORBT,"USR.`"_ORBUSR,"ORB LAB "_ORBGL_" THRESHOLD","I")
+3 if +$GET(ORBT)<1
QUIT
+4 WRITE !!,"Current "_ORBGL_" lab thresholds for ",$$GET1^DIQ(200,ORBUSR_",",.01),":"
+5 SET ORBLAB=""
FOR
SET ORBLAB=$ORDER(ORBT(ORBLAB))
if ORBLAB=""
QUIT
Begin DoDot:1
+6 SET ORBSP=$PIECE(ORBLAB,";",2)
+7 SET ORBLABN=$PIECE(^LAB(60,+ORBLAB,0),U)
+8 SET ORBSPN=$PIECE(^LAB(61,ORBSP,0),U)
+9 SET ORBA(ORBLABN,ORBSPN)=ORBT(ORBLAB)
End DoDot:1
+10 SET ORBLABN=""
FOR
SET ORBLABN=$ORDER(ORBA(ORBLABN))
if ORBLABN=""
QUIT
Begin DoDot:1
+11 SET ORBSPN=""
FOR
SET ORBSPN=$ORDER(ORBA(ORBLABN,ORBSPN))
if ORBSPN=""
QUIT
Begin DoDot:2
+12 WRITE !?2,ORBLABN
+13 WRITE ?40,ORBSPN
+14 WRITE ?65,ORBA(ORBLABN,ORBSPN)
End DoDot:2
End DoDot:1
+15 QUIT
