- 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 Jan 18, 2025@03:28:37 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