source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3MGR2.m@ 770

Last change on this file since 770 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1ORB3MGR2 ; SLC/AEB - Utilities for Manager Options - Notifications Parameters ;4/23/96 16:53
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,85,105**;Dec 17, 1997
3 ;
4USERDEL ; Purge undesired alerts/notifications for a user
5 N ORBDUZ,XQ1
6 W !!,"This option purges an existing alert/notification for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
7UDEL2 D USERDEL^XQALERT
8 Q
9RECIPURG ; Purge existing alerts/notifications for a user
10 N ORBDUZ,XQ1
11 W !!,"This option purges all existing alerts/notifications for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
12 ; Get user DUZ number
13 K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
14 S ^TMP("ORB",$J,"ORBDUZ")=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
15 S ORBDUZ=^TMP("ORB",$J,"ORBDUZ")
16 S XQ1=$S($D(^TMP("ORB",$J,"ORBDUZ")):^TMP("ORB",$J,"ORBDUZ"),1:DUZ)
17 W !!,$C(7),"Do you want to purge all alerts/notifications for ",$P(^VA(200,XQ1,0),"^") S %=2 D YN^DICN D
18 .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
19 Q:%'=1 W !!,"Purging alerts/notifications...",!
20 K %
21 D RECIPURG^XQALBUTL(XQ1)
22 K ^TMP("ORB",$J)
23 Q
24PTPURG ; Purge existing alerts/notifications for a patient
25 W !!,"This option purges all existing alerts/notifications for a patient.",!?5,"*** USE WITH CAUTION ***"
26 K DIC S DIC="^DPT(",DIC(0)="AENQM",DIC("A")="Enter alert/notification patient's name: " D ^DIC Q:Y<1
27 K DIC,DUOUT,DTOUT
28 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...",!
29 K %
30 D PTPURG^XQALBUTL(+Y)
31 K Y
32 Q
33NOTIPURG ; Purge all instances of a notification
34 W !!,"This option purges all existing instances of a notification.",!?5,"*** USE WITH CAUTION ***"
35 K DIC S DIC="^ORD(100.9,",DIC(0)="AENQ",DIC("A")="Enter notification name: " D ^DIC Q:Y<1
36 K DIC,DUOUT,DTOUT
37 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...",!
38 K %
39 D NOTIPURG^XQALBUTL(+Y)
40 K Y
41 Q
42ERASEALL ; Edit ORB ERASE ALL parameter for a User
43 N PIEN
44 S PIEN=0,PIEN=$O(^XTV(8989.51,"B","ORB ERASE ALL",PIEN)) Q:PIEN=""
45 D TITLE^ORB3MGR1("Set User's Ability to Erase All His Notifications/Alerts")
46 D PROC^ORB3MGR1(PIEN)
47 Q
48USRNOTS ; List notifications a user could receive
49 N ORBUSR
50 ; Get user DUZ number
51 K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
52 S ORBUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
53 D USRNOTS^ORB3U2(ORBUSR)
54 Q
55LABTHRES ; set lab threshold parameter for user
56 N ORBT,ORBLAB,ORBSP,ORBTHRES,ORBERR,DIC,DIR,Y
57 N ORBUSR,ORBGL,ORBLABN,ORBSPN
58 ;
59 W !,$C(7),"Do you want to add, modify or remove lab thresholds" S %=1 D YN^DICN D
60 .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
61 Q:%'=1 K %
62 ;
63 F D Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
64 .W !
65 .S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name (""^"" to exit): "
66 .S DIC("B")=$S($G(ORBUSR):ORBUSR,1:DUZ) D ^DIC Q:Y<1
67 .S ORBUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
68 .;
69 .D DISPTHR(ORBUSR,">")
70 .D DISPTHR(ORBUSR,"<")
71 .W !
72 .;
73 .;get Lab test:
74 .S DIC=60,DIC(0)="AEMQ",DIC("A")="Select LAB TEST: " D ^DIC K DIC Q:Y<1
75 .S ORBLAB=+Y,ORBLABN=$P(Y,U,2)
76 .;
77 .;get test Specimen:
78 .S DIC=61,DIC(0)="AEMQ",DIC("A")="Select SPECIMEN: " D ^DIC K DIC Q:Y<1
79 .S ORBSP=+Y,ORBSPN=$P(Y,U,2)
80 .;
81 .S ORBLABSP=ORBLAB_";"_ORBSP
82 .;
83 .;get greater than or less than:
84 .K DIR S DIR(0)="SO^>:Greater Than;<:Less Than",DIR("A")="Operator on Lab Value: "
85 .S DIR("?")="Enter '>' to be alerted for results GREATER than the lab value or '<' to be alerted for results LESS than the lab value."
86 .D ^DIR K DIR Q:$D(DIRUT)
87 .S ORBGL=Y
88 .;
89 .;get threshold value:
90 .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."
91 .D ^DIR K DIR Q:$D(DIRUT)
92 .S ORBTHRES=Y
93 .;
94 .I $G(ORBTHRES)=0 D
95 ..W !,"Removing "_ORBGL_" threshold for "_ORBLABN_" "_ORBSPN_"..."
96 ..D DEL^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,.ORBERR)
97 ..I ORBERR W !,"Error removing lab threshold: ",$P(ORBERR,U,2)
98 .I $G(ORBTHRES)>0 D
99 ..D EN^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,ORBTHRES,.ORBERR)
100 ..I ORBERR W !,"Error adding lab threshold: ",$P(ORBERR,U,2)
101 .;
102 .D DISPTHR(ORBUSR,ORBGL)
103 ;I $L($G(ORBGL)),('$D(DIRUT)) D DISPTHR(ORBUSR,ORBGL)
104 Q
105DISPTHR(ORBUSR,ORBGL) ;display uer's ORB LAB THRESHOLD parameter values
106 N ORBT,ORBA,ORBLAB,ORBLABN,ORBSP,ORBSPN
107 D GETLST^XPAR(.ORBT,"USR.`"_ORBUSR,"ORB LAB "_ORBGL_" THRESHOLD","I")
108 Q:+$G(ORBT)<1
109 W !!,"Current "_ORBGL_" lab thresholds for ",$$GET1^DIQ(200,ORBUSR_",",.01),":"
110 S ORBLAB="" F S ORBLAB=$O(ORBT(ORBLAB)) Q:ORBLAB="" D
111 .S ORBSP=$P(ORBLAB,";",2)
112 .S ORBLABN=$P(^LAB(60,+ORBLAB,0),U)
113 .S ORBSPN=$P(^LAB(61,ORBSP,0),U)
114 .S ORBA(ORBLABN,ORBSPN)=ORBT(ORBLAB)
115 S ORBLABN="" F S ORBLABN=$O(ORBA(ORBLABN)) Q:ORBLABN="" D
116 .S ORBSPN="" F S ORBSPN=$O(ORBA(ORBLABN,ORBSPN)) Q:ORBSPN="" D
117 ..W !?2,ORBLABN
118 ..W ?40,ORBSPN
119 ..W ?65,ORBA(ORBLABN,ORBSPN)
120 Q
Note: See TracBrowser for help on using the repository browser.