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

ORB3MGR2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. USERDEL ; Purge undesired alerts/notifications for a user
  1. N ORBDUZ,XQ1
  1. W !!,"This option purges an existing alert/notification for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
  1. UDEL2 D USERDEL^XQALERT
  1. Q
  1. RECIPURG ; Purge existing alerts/notifications for a user
  1. N ORBDUZ,XQ1
  1. W !!,"This option purges all existing alerts/notifications for a recipient/user.",!?5,"*** USE WITH CAUTION ***"
  1. ; Get user DUZ number
  1. K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
  1. S ^TMP("ORB",$J,"ORBDUZ")=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
  1. S ORBDUZ=^TMP("ORB",$J,"ORBDUZ")
  1. S XQ1=$S($D(^TMP("ORB",$J,"ORBDUZ")):^TMP("ORB",$J,"ORBDUZ"),1:DUZ)
  1. W !!,$C(7),"Do you want to purge all alerts/notifications for ",$P(^VA(200,XQ1,0),"^") S %=2 D YN^DICN D
  1. .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
  1. Q:%'=1 W !!,"Purging alerts/notifications...",!
  1. K %
  1. D RECIPURG^XQALBUTL(XQ1)
  1. K ^TMP("ORB",$J)
  1. Q
  1. PTPURG ; Purge existing alerts/notifications for a patient
  1. W !!,"This option purges all existing alerts/notifications for a patient.",!?5,"*** USE WITH CAUTION ***"
  1. K DIC S DIC="^DPT(",DIC(0)="AENQM",DIC("A")="Enter alert/notification patient's name: " D ^DIC Q:Y<1
  1. K DIC,DUOUT,DTOUT
  1. 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...",!
  1. K %
  1. D PTPURG^XQALBUTL(+Y)
  1. K Y
  1. Q
  1. NOTIPURG ; Purge all instances of a notification
  1. W !!,"This option purges all existing instances of a notification.",!?5,"*** USE WITH CAUTION ***"
  1. K DIC S DIC="^ORD(100.9,",DIC(0)="AENQ",DIC("A")="Enter notification name: " D ^DIC Q:Y<1
  1. K DIC,DUOUT,DTOUT
  1. 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...",!
  1. K %
  1. D NOTIPURG^XQALBUTL(+Y)
  1. K Y
  1. Q
  1. ERASEALL ; Edit ORB ERASE ALL parameter for a User
  1. N PIEN
  1. S PIEN=0,PIEN=$O(^XTV(8989.51,"B","ORB ERASE ALL",PIEN)) Q:PIEN=""
  1. D TITLE^ORB3MGR1("Set User's Ability to Erase All His Notifications/Alerts")
  1. D PROC^ORB3MGR1(PIEN)
  1. Q
  1. USRNOTS ; List notifications a user could receive
  1. N ORBUSR
  1. ; Get user DUZ number
  1. K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
  1. S ORBUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
  1. D USRNOTS^ORB3U2(ORBUSR)
  1. Q
  1. LABTHRES ; set lab threshold parameter for user
  1. N ORBT,ORBLAB,ORBSP,ORBTHRES,ORBERR,DIC,DIR,Y
  1. N ORBUSR,ORBGL,ORBLABN,ORBSPN
  1. ;
  1. W !,$C(7),"Do you want to add, modify or remove lab thresholds" S %=1 D YN^DICN D
  1. .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
  1. Q:%'=1 K %
  1. ;
  1. F D Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
  1. .W !
  1. .S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name (""^"" to exit): "
  1. .S DIC("B")=$S($G(ORBUSR):ORBUSR,1:DUZ) D ^DIC Q:Y<1
  1. .S ORBUSR=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
  1. .;
  1. .D DISPTHR(ORBUSR,">")
  1. .D DISPTHR(ORBUSR,"<")
  1. .W !
  1. .;
  1. .;get Lab test:
  1. .S DIC=60,DIC(0)="AEMQ",DIC("A")="Select LAB TEST: " D ^DIC K DIC Q:Y<1
  1. .S ORBLAB=+Y,ORBLABN=$P(Y,U,2)
  1. .;
  1. .;get test Specimen:
  1. .S DIC=61,DIC(0)="AEMQ",DIC("A")="Select SPECIMEN: " D ^DIC K DIC Q:Y<1
  1. .S ORBSP=+Y,ORBSPN=$P(Y,U,2)
  1. .;
  1. .S ORBLABSP=ORBLAB_";"_ORBSP
  1. .;
  1. .;get greater than or less than:
  1. .K DIR S DIR(0)="SO^>:Greater Than;<:Less Than",DIR("A")="Operator on Lab Value: "
  1. .S DIR("?")="Enter '>' to be alerted for results GREATER than the lab value or '<' to be alerted for results LESS than the lab value."
  1. .D ^DIR K DIR Q:$D(DIRUT)
  1. .S ORBGL=Y
  1. .;
  1. .;get threshold value:
  1. .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."
  1. .D ^DIR K DIR Q:$D(DIRUT)
  1. .S ORBTHRES=Y
  1. .;
  1. .I $G(ORBTHRES)=0 D
  1. ..W !,"Removing "_ORBGL_" threshold for "_ORBLABN_" "_ORBSPN_"..."
  1. ..D DEL^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,.ORBERR)
  1. ..I ORBERR W !,"Error removing lab threshold: ",$P(ORBERR,U,2)
  1. .I $G(ORBTHRES)>0 D
  1. ..D EN^XPAR(ORBUSR_";VA(200,","ORB LAB "_ORBGL_" THRESHOLD",ORBLABSP,ORBTHRES,.ORBERR)
  1. ..I ORBERR W !,"Error adding lab threshold: ",$P(ORBERR,U,2)
  1. .;
  1. .D DISPTHR(ORBUSR,ORBGL)
  1. ;I $L($G(ORBGL)),('$D(DIRUT)) D DISPTHR(ORBUSR,ORBGL)
  1. Q
  1. DISPTHR(ORBUSR,ORBGL) ;display uer's ORB LAB THRESHOLD parameter values
  1. N ORBT,ORBA,ORBLAB,ORBLABN,ORBSP,ORBSPN
  1. D GETLST^XPAR(.ORBT,"USR.`"_ORBUSR,"ORB LAB "_ORBGL_" THRESHOLD","I")
  1. Q:+$G(ORBT)<1
  1. W !!,"Current "_ORBGL_" lab thresholds for ",$$GET1^DIQ(200,ORBUSR_",",.01),":"
  1. S ORBLAB="" F S ORBLAB=$O(ORBT(ORBLAB)) Q:ORBLAB="" D
  1. .S ORBSP=$P(ORBLAB,";",2)
  1. .S ORBLABN=$P(^LAB(60,+ORBLAB,0),U)
  1. .S ORBSPN=$P(^LAB(61,ORBSP,0),U)
  1. .S ORBA(ORBLABN,ORBSPN)=ORBT(ORBLAB)
  1. S ORBLABN="" F S ORBLABN=$O(ORBA(ORBLABN)) Q:ORBLABN="" D
  1. .S ORBSPN="" F S ORBSPN=$O(ORBA(ORBLABN,ORBSPN)) Q:ORBSPN="" D
  1. ..W !?2,ORBLABN
  1. ..W ?40,ORBSPN
  1. ..W ?65,ORBA(ORBLABN,ORBSPN)
  1. Q