ORB3TIM2 ;SLC/CLA - Routine to trigger time-related notifications ; 9/27/17 1:13pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**102,215,251,265,356,350,450**;Dec 17, 1997;Build 14
;;Per VA Directive 6402, this routine should not be modified.
;
;DBIA SECTION
;10035 - ^DPT(
;10003 - ^%DPT
;10006 - ^DIC
; 325 - ^VADPT2
;10103 - ^XLFDT
; 2263 - ^XPAR
;
EXPIR ;trigger expiring order notifs
N EDT,EXDT,EXORN,ORBDNR,ORPT,ORBRSLT,RXORD,ORLASTDT,X,Y,%DT
N OIFILE,ORBY,ORBZ,ORBI,ORSCH,ORSCHFIL,ONETIME,ORST,ORNG,ORDT,ORDW,ORHOL
N EXOI,ORBLST,ORBERR,OITXT,PTLOC,ORSDT,ORNOW,ORLDT
;
S ORNOW=$$NOW^XLFDT
;
I '$D(^XTMP("ORB LAST EXPIRE")) D ;holds last dt EXPIR processed
.S ^XTMP("ORB LAST EXPIRE",0)=$$FMADD^XLFDT(ORNOW,7,"","","")_U
;
;determine number of days to return orders using day of week & holidays
F ORNG=1:1 D I ORHOL=0,ORDW=0 Q
.S ORDW=$S($H-4+ORNG#7>4:1,1:0) ;if Sat or Sun, ORDW=0
.S ORDT=$$FMADD^XLFDT(DT,ORNG)
.K DIC S DIC="^HOLIDAY(",X=ORDT D ^DIC
.S ORHOL=$S(+$G(Y)>0:1,1:0) ;if ORDT is a holiday, ORHOL=0
S %DT="",X="T+"_ORNG D ^%DT
S EDT=Y_".2400"
K DIC
;
;get DNR OIs:
S OIFILE=$$TERMLKUP^ORB31(.ORBY,"DNR")
;
;get local admin schedules for ONE TIME MED:
S ORSCHFIL=$$TERMLKUP^ORB31(.ORBZ,"ONE TIME MED")
;
;examine expiring orders:
S ORLASTDT=$P(^XTMP("ORB LAST EXPIRE",0),U,2)
S EXDT=$S($L(ORLASTDT):ORLASTDT,1:ORNOW)
F S EXDT=$O(^OR(100,"AE",EXDT)) Q:(EXDT="") D Q:ORBRSLT<0
.S ORBRSLT=$$FMDIFF^XLFDT(EDT,$P(EXDT,".")_".2400",2) ;diff in seconds
.Q:ORBRSLT<0
.S EXORN="" F S EXORN=$O(^OR(100,"AE",EXDT,EXORN)) Q:EXORN="" D
..;
..;*356 Protect, if x-ref dangles.
..I '$D(^OR(100,EXORN)) K ^OR(100,"AE",EXDT,EXORN) Q
..;
..;Quit if isn't at least next day after order's Date of Last Activity:
..S ORLDT=$P(^OR(100,EXORN,3),U)
..Q:$$FMDIFF^XLFDT(ORNOW,ORLDT)<1
..;
..Q:$D(^XTMP("ORB LAST EXPIRE",EXORN)) ;quit if order already processed
..S ^XTMP("ORB LAST EXPIRE",EXORN)=EXDT
..;
..S ORPT=$$PT^ORQOR2(EXORN) ; get pt assoc w/order
..Q:+$G(ORPT)<1
..;
..Q:+$G(^DPT(ORPT,.35))>0 ; quit if pt deceased - DBIA #10035
..;
..S PTLOC=$G(^DPT(+$G(ORPT),.1)),PTLOC=$S($L(PTLOC):PTLOC,1:"OUTPT")
..;
..; is expiring order a DNR order:
..I $D(ORBY),(+$G(OIFILE)=101.43) D
...F ORBI=1:1:ORBY D
....S ORBDNR=$P(ORBY(ORBI),U) I ORBDNR=$$OI^ORQOR2(EXORN) D
.....S ORST=$P($$STATUS^ORQOR2(EXORN),U,2)
.....I ORST'="DISCONTINUED",ORST'="COMPLETE",ORST'="EXPIRED",ORST'="CANCELLED",ORST'="DISCONTINUED/EDIT" D
......D EN^ORB3(45,ORPT,EXORN,"","",EXORN_"@") ;trigger DNR notif
..;
..; is expiring order a flagged oi:
..;S EXOI=$$OI^ORQOR2(EXORN) I +$G(EXOI)>0 D
..;patch 450, all items not being checked
..S EXOIC=0
..F S EXOIC=$O(^OR(100,EXORN,.1,EXOIC)) Q:EXOIC="" D
...S EXOI=$G(^OR(100,EXORN,.1,EXOIC,0))
...I $L(PTLOC),PTLOC'="OUTPT",+$G(EXOI)>0 D
....D ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - INPT","`"_EXOI,.ORBERR)
....I 'ORBERR,'$G(ORBLST) D ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - INPT PR","`"_EXOI,.ORBERR)
....I 'ORBERR,$G(ORBLST)>0 D
.....S OITXT=$P(^ORD(101.43,EXOI,0),U)
.....S ORSDT=$P(^OR(100,EXORN,0),U,8),ORSDT=$$FMTE^XLFDT(ORSDT,"2P")
.....D EN^ORB3(64,ORPT,EXORN,"","["_PTLOC_"] Order expiring: "_OITXT_" "_ORSDT,EXOI) ;trigger Expiring Flagged OI - INPT notification
...;
...I $L(PTLOC),PTLOC="OUTPT" D
....D ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - OUTPT","`"_EXOI,.ORBERR)
....;*356 Add OUTPT PR
....I 'ORBERR,'$G(ORBLST) D ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - OUTPT PR","`"_EXOI,.ORBERR)
....I 'ORBERR,$G(ORBLST)>0 D
.....S OITXT=$P(^ORD(101.43,EXOI,0),U)
.....S ORSDT=$P(^OR(100,EXORN,0),U,8),ORSDT=$$FMTE^XLFDT(ORSDT,"2P")
.....D EN^ORB3(65,ORPT,EXORN,"","["_PTLOC_"] Order expiring: "_OITXT_" "_ORSDT,EXOI) ;trigger Expiring Flagged OI - OUTPT notification
..;
..;is expiring order a med order:
..S RXORD=$$DGRX^ORQOR2(EXORN)
..I $L(RXORD) D ;if expiring order is a med order
...;
...N DFN S DFN=ORPT
...D ADM^VADPT2
...;
...I (RXORD="OUTPATIENT MEDICATIONS")!(+$G(VADMVT)<1&(RXORD'?1"CLINIC ".E)) D
....D EN^ORB3(72,ORPT,EXORN,"","",EXORN_"@") ;trigger outpt notif
...;
...Q:RXORD="OUTPATIENT MEDICATIONS" ;quit if an outpt med
...Q:+$G(VADMVT)<1&(RXORD'?1"CLINIC ".E) ;quit if an outpt
...;
...K VADMVT
...;
...;is schedule for the order a ONE TIME MED:
...S ONETIME=0
...I $D(ORBZ),(+$G(ORSCHFIL)=51.1) F ORBI=1:1:ORBZ D
....S ORSCH=$P(ORBZ(ORBI),U,2)
....I ORSCH=$$VALUE^ORCSAVE2(EXORN,"SCHEDULE") S ONETIME=1 Q
...Q:+$G(ONETIME)=1 ;quit if one time med
...;
...;check if this is an IMO order and what it is,send an M.E.-OUTPT alert
...I RXORD?1"CLINIC ".E D Q
....N ORDLG,ORDG,ORDLGNM,FLAG,ORX
....S FLAG=0
....S ORDLG=$P($G(^OR(100,EXORN,0)),U,5) Q:$P(ORDLG,";",2)'="ORD(101.41,"
....S ORDLGNM=$P($G(^ORD(101.41,+ORDLG,0)),U)
....S ORDG=$P($G(^ORD(101.41,+ORDLG,0)),U,2)
....I ORDLGNM="PSJ OR PAT OE"!(ORDLGNM="PSJI OR PAT FLUID OE") S FLAG=1
....I 'FLAG F ORX="INPATIENT MEDICATIONS","IV MEDICATIONS","UNIT DOSE MEDICATIONS","CLINIC ORDERS","CLINIC INFUSIONS","CLINIC MEDICATIONS" I $$UPPER^ORU(ORDG)=ORX D
.....S FLAG=1
.....I ORX="IV MEDICATIONS",(+$$IVRENEW(EXORN)=0) S FLAG=0
.....I ORX="UNIT DOSE MEDICATIONS",(+$$UDRENEW(EXORN,EXDT)=0) S FLAG=0
....I FLAG D EN^ORB3(72,ORPT,EXORN,"","",EXORN_"@") ;trigger outpt notif
...;
...;quit if inpt/unit dose med and med is not renewable:
...I RXORD="UNIT DOSE MEDICATIONS",(+$$UDRENEW(EXORN,EXDT)=0) Q
...;
...;quit if IV med and med is not renewable:
...I RXORD="IV MEDICATIONS",(+$$IVRENEW(EXORN)=0) Q
...;
...D EN^ORB3(47,ORPT,EXORN,"","",EXORN_"@") ;trigger notif
S ^XTMP("ORB LAST EXPIRE",0)=$$FMADD^XLFDT(ORNOW,7,"","","")_U_$$NOW^XLFDT
D EXCLN(ORNOW)
Q
UDRENEW(EXORN,EXDT) ;extr function returns 1 if med is renewable, 0 if not
N ORNOW,ORSLT,ORSTATUS
S ORSLT=0
S ORSTATUS=$P($$STATUS^ORQOR2(EXORN),U,2)
I ORSTATUS="ACTIVE" Q 1 ;renewable if "active"
I ORSTATUS="HOLD" Q 1 ;renewable if "on hold"
I ORSTATUS="EXPIRED" D
.S ORNOW=$$NOW^XLFDT
.;renewable if expired w/in past 4 days:
.I $$FMDIFF^XLFDT(ORNOW,EXDT,1)<4 S ORSLT=1
Q ORSLT
;
IVRENEW(EXORN) ;extr function returns 1 if med is renewable, 0 if not
N ORSLT,ORSTATUS
S ORSLT=0
S ORSTATUS=$P($$STATUS^ORQOR2(EXORN),U,2)
I ORSTATUS="ACTIVE" Q 1 ;renewable if "active"
I ORSTATUS="HOLD" Q 1 ;renewable if "on hold"
I ORSTATUS="EXPIRED" Q 1 ;renewable if "expired"
Q ORSLT
;
EXCLN(ORNOW) ;clean up old entires in ^XTMP("ORB LAST EXPIRE")
N ORN,ORDT
S ORN=1
F S ORN=$O(^XTMP("ORB LAST EXPIRE",ORN)) Q:ORN="" D
.S ORDT=$G(^XTMP("ORB LAST EXPIRE",ORN))
.I $L(ORDT),(ORDT<ORNOW) D
..K ^XTMP("ORB LAST EXPIRE",ORN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3TIM2 6822 printed Apr 09, 2024@21:29:07 Page 2
ORB3TIM2 ;SLC/CLA - Routine to trigger time-related notifications ; 9/27/17 1:13pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**102,215,251,265,356,350,450**;Dec 17, 1997;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;DBIA SECTION
+5 ;10035 - ^DPT(
+6 ;10003 - ^%DPT
+7 ;10006 - ^DIC
+8 ; 325 - ^VADPT2
+9 ;10103 - ^XLFDT
+10 ; 2263 - ^XPAR
+11 ;
EXPIR ;trigger expiring order notifs
+1 NEW EDT,EXDT,EXORN,ORBDNR,ORPT,ORBRSLT,RXORD,ORLASTDT,X,Y,%DT
+2 NEW OIFILE,ORBY,ORBZ,ORBI,ORSCH,ORSCHFIL,ONETIME,ORST,ORNG,ORDT,ORDW,ORHOL
+3 NEW EXOI,ORBLST,ORBERR,OITXT,PTLOC,ORSDT,ORNOW,ORLDT
+4 ;
+5 SET ORNOW=$$NOW^XLFDT
+6 ;
+7 ;holds last dt EXPIR processed
IF '$DATA(^XTMP("ORB LAST EXPIRE"))
Begin DoDot:1
+8 SET ^XTMP("ORB LAST EXPIRE",0)=$$FMADD^XLFDT(ORNOW,7,"","","")_U
End DoDot:1
+9 ;
+10 ;determine number of days to return orders using day of week & holidays
+11 FOR ORNG=1:1
Begin DoDot:1
+12 ;if Sat or Sun, ORDW=0
SET ORDW=$SELECT($HOROLOG-4+ORNG#7>4:1,1:0)
+13 SET ORDT=$$FMADD^XLFDT(DT,ORNG)
+14 KILL DIC
SET DIC="^HOLIDAY("
SET X=ORDT
DO ^DIC
+15 ;if ORDT is a holiday, ORHOL=0
SET ORHOL=$SELECT(+$GET(Y)>0:1,1:0)
End DoDot:1
IF ORHOL=0
IF ORDW=0
QUIT
+16 SET %DT=""
SET X="T+"_ORNG
DO ^%DT
+17 SET EDT=Y_".2400"
+18 KILL DIC
+19 ;
+20 ;get DNR OIs:
+21 SET OIFILE=$$TERMLKUP^ORB31(.ORBY,"DNR")
+22 ;
+23 ;get local admin schedules for ONE TIME MED:
+24 SET ORSCHFIL=$$TERMLKUP^ORB31(.ORBZ,"ONE TIME MED")
+25 ;
+26 ;examine expiring orders:
+27 SET ORLASTDT=$PIECE(^XTMP("ORB LAST EXPIRE",0),U,2)
+28 SET EXDT=$SELECT($LENGTH(ORLASTDT):ORLASTDT,1:ORNOW)
+29 FOR
SET EXDT=$ORDER(^OR(100,"AE",EXDT))
if (EXDT="")
QUIT
Begin DoDot:1
+30 ;diff in seconds
SET ORBRSLT=$$FMDIFF^XLFDT(EDT,$PIECE(EXDT,".")_".2400",2)
+31 if ORBRSLT<0
QUIT
+32 SET EXORN=""
FOR
SET EXORN=$ORDER(^OR(100,"AE",EXDT,EXORN))
if EXORN=""
QUIT
Begin DoDot:2
+33 ;
+34 ;*356 Protect, if x-ref dangles.
+35 IF '$DATA(^OR(100,EXORN))
KILL ^OR(100,"AE",EXDT,EXORN)
QUIT
+36 ;
+37 ;Quit if isn't at least next day after order's Date of Last Activity:
+38 SET ORLDT=$PIECE(^OR(100,EXORN,3),U)
+39 if $$FMDIFF^XLFDT(ORNOW,ORLDT)<1
QUIT
+40 ;
+41 ;quit if order already processed
if $DATA(^XTMP("ORB LAST EXPIRE",EXORN))
QUIT
+42 SET ^XTMP("ORB LAST EXPIRE",EXORN)=EXDT
+43 ;
+44 ; get pt assoc w/order
SET ORPT=$$PT^ORQOR2(EXORN)
+45 if +$GET(ORPT)<1
QUIT
+46 ;
+47 ; quit if pt deceased - DBIA #10035
if +$GET(^DPT(ORPT,.35))>0
QUIT
+48 ;
+49 SET PTLOC=$GET(^DPT(+$GET(ORPT),.1))
SET PTLOC=$SELECT($LENGTH(PTLOC):PTLOC,1:"OUTPT")
+50 ;
+51 ; is expiring order a DNR order:
+52 IF $DATA(ORBY)
IF (+$GET(OIFILE)=101.43)
Begin DoDot:3
+53 FOR ORBI=1:1:ORBY
Begin DoDot:4
+54 SET ORBDNR=$PIECE(ORBY(ORBI),U)
IF ORBDNR=$$OI^ORQOR2(EXORN)
Begin DoDot:5
+55 SET ORST=$PIECE($$STATUS^ORQOR2(EXORN),U,2)
+56 IF ORST'="DISCONTINUED"
IF ORST'="COMPLETE"
IF ORST'="EXPIRED"
IF ORST'="CANCELLED"
IF ORST'="DISCONTINUED/EDIT"
Begin DoDot:6
+57 ;trigger DNR notif
DO EN^ORB3(45,ORPT,EXORN,"","",EXORN_"@")
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+58 ;
+59 ; is expiring order a flagged oi:
+60 ;S EXOI=$$OI^ORQOR2(EXORN) I +$G(EXOI)>0 D
+61 ;patch 450, all items not being checked
+62 SET EXOIC=0
+63 FOR
SET EXOIC=$ORDER(^OR(100,EXORN,.1,EXOIC))
if EXOIC=""
QUIT
Begin DoDot:3
+64 SET EXOI=$GET(^OR(100,EXORN,.1,EXOIC,0))
+65 IF $LENGTH(PTLOC)
IF PTLOC'="OUTPT"
IF +$GET(EXOI)>0
Begin DoDot:4
+66 DO ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - INPT","`"_EXOI,.ORBERR)
+67 IF 'ORBERR
IF '$GET(ORBLST)
DO ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - INPT PR","`"_EXOI,.ORBERR)
+68 IF 'ORBERR
IF $GET(ORBLST)>0
Begin DoDot:5
+69 SET OITXT=$PIECE(^ORD(101.43,EXOI,0),U)
+70 SET ORSDT=$PIECE(^OR(100,EXORN,0),U,8)
SET ORSDT=$$FMTE^XLFDT(ORSDT,"2P")
+71 ;trigger Expiring Flagged OI - INPT notification
DO EN^ORB3(64,ORPT,EXORN,"","["_PTLOC_"] Order expiring: "_OITXT_" "_ORSDT,EXOI)
End DoDot:5
End DoDot:4
+72 ;
+73 IF $LENGTH(PTLOC)
IF PTLOC="OUTPT"
Begin DoDot:4
+74 DO ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - OUTPT","`"_EXOI,.ORBERR)
+75 ;*356 Add OUTPT PR
+76 IF 'ORBERR
IF '$GET(ORBLST)
DO ENVAL^XPAR(.ORBLST,"ORB OI EXPIRING - OUTPT PR","`"_EXOI,.ORBERR)
+77 IF 'ORBERR
IF $GET(ORBLST)>0
Begin DoDot:5
+78 SET OITXT=$PIECE(^ORD(101.43,EXOI,0),U)
+79 SET ORSDT=$PIECE(^OR(100,EXORN,0),U,8)
SET ORSDT=$$FMTE^XLFDT(ORSDT,"2P")
+80 ;trigger Expiring Flagged OI - OUTPT notification
DO EN^ORB3(65,ORPT,EXORN,"","["_PTLOC_"] Order expiring: "_OITXT_" "_ORSDT,EXOI)
End DoDot:5
End DoDot:4
End DoDot:3
+81 ;
+82 ;is expiring order a med order:
+83 SET RXORD=$$DGRX^ORQOR2(EXORN)
+84 ;if expiring order is a med order
IF $LENGTH(RXORD)
Begin DoDot:3
+85 ;
+86 NEW DFN
SET DFN=ORPT
+87 DO ADM^VADPT2
+88 ;
+89 IF (RXORD="OUTPATIENT MEDICATIONS")!(+$GET(VADMVT)<1&(RXORD'?1"CLINIC ".E))
Begin DoDot:4
+90 ;trigger outpt notif
DO EN^ORB3(72,ORPT,EXORN,"","",EXORN_"@")
End DoDot:4
+91 ;
+92 ;quit if an outpt med
if RXORD="OUTPATIENT MEDICATIONS"
QUIT
+93 ;quit if an outpt
if +$GET(VADMVT)<1&(RXORD'?1"CLINIC ".E)
QUIT
+94 ;
+95 KILL VADMVT
+96 ;
+97 ;is schedule for the order a ONE TIME MED:
+98 SET ONETIME=0
+99 IF $DATA(ORBZ)
IF (+$GET(ORSCHFIL)=51.1)
FOR ORBI=1:1:ORBZ
Begin DoDot:4
+100 SET ORSCH=$PIECE(ORBZ(ORBI),U,2)
+101 IF ORSCH=$$VALUE^ORCSAVE2(EXORN,"SCHEDULE")
SET ONETIME=1
QUIT
End DoDot:4
+102 ;quit if one time med
if +$GET(ONETIME)=1
QUIT
+103 ;
+104 ;check if this is an IMO order and what it is,send an M.E.-OUTPT alert
+105 IF RXORD?1"CLINIC ".E
Begin DoDot:4
+106 NEW ORDLG,ORDG,ORDLGNM,FLAG,ORX
+107 SET FLAG=0
+108 SET ORDLG=$PIECE($GET(^OR(100,EXORN,0)),U,5)
if $PIECE(ORDLG,";",2)'="ORD(101.41,"
QUIT
+109 SET ORDLGNM=$PIECE($GET(^ORD(101.41,+ORDLG,0)),U)
+110 SET ORDG=$PIECE($GET(^ORD(101.41,+ORDLG,0)),U,2)
+111 IF ORDLGNM="PSJ OR PAT OE"!(ORDLGNM="PSJI OR PAT FLUID OE")
SET FLAG=1
+112 IF 'FLAG
FOR ORX="INPATIENT MEDICATIONS","IV MEDICATIONS","UNIT DOSE MEDICATIONS","CLINIC ORDERS","CLINIC INFUSIONS","CLINIC MEDICATIONS"
IF $$UPPER^ORU(ORDG)=ORX
Begin DoDot:5
+113 SET FLAG=1
+114 IF ORX="IV MEDICATIONS"
IF (+$$IVRENEW(EXORN)=0)
SET FLAG=0
+115 IF ORX="UNIT DOSE MEDICATIONS"
IF (+$$UDRENEW(EXORN,EXDT)=0)
SET FLAG=0
End DoDot:5
+116 ;trigger outpt notif
IF FLAG
DO EN^ORB3(72,ORPT,EXORN,"","",EXORN_"@")
End DoDot:4
QUIT
+117 ;
+118 ;quit if inpt/unit dose med and med is not renewable:
+119 IF RXORD="UNIT DOSE MEDICATIONS"
IF (+$$UDRENEW(EXORN,EXDT)=0)
QUIT
+120 ;
+121 ;quit if IV med and med is not renewable:
+122 IF RXORD="IV MEDICATIONS"
IF (+$$IVRENEW(EXORN)=0)
QUIT
+123 ;
+124 ;trigger notif
DO EN^ORB3(47,ORPT,EXORN,"","",EXORN_"@")
End DoDot:3
End DoDot:2
End DoDot:1
if ORBRSLT<0
QUIT
+125 SET ^XTMP("ORB LAST EXPIRE",0)=$$FMADD^XLFDT(ORNOW,7,"","","")_U_$$NOW^XLFDT
+126 DO EXCLN(ORNOW)
+127 QUIT
UDRENEW(EXORN,EXDT) ;extr function returns 1 if med is renewable, 0 if not
+1 NEW ORNOW,ORSLT,ORSTATUS
+2 SET ORSLT=0
+3 SET ORSTATUS=$PIECE($$STATUS^ORQOR2(EXORN),U,2)
+4 ;renewable if "active"
IF ORSTATUS="ACTIVE"
QUIT 1
+5 ;renewable if "on hold"
IF ORSTATUS="HOLD"
QUIT 1
+6 IF ORSTATUS="EXPIRED"
Begin DoDot:1
+7 SET ORNOW=$$NOW^XLFDT
+8 ;renewable if expired w/in past 4 days:
+9 IF $$FMDIFF^XLFDT(ORNOW,EXDT,1)<4
SET ORSLT=1
End DoDot:1
+10 QUIT ORSLT
+11 ;
IVRENEW(EXORN) ;extr function returns 1 if med is renewable, 0 if not
+1 NEW ORSLT,ORSTATUS
+2 SET ORSLT=0
+3 SET ORSTATUS=$PIECE($$STATUS^ORQOR2(EXORN),U,2)
+4 ;renewable if "active"
IF ORSTATUS="ACTIVE"
QUIT 1
+5 ;renewable if "on hold"
IF ORSTATUS="HOLD"
QUIT 1
+6 ;renewable if "expired"
IF ORSTATUS="EXPIRED"
QUIT 1
+7 QUIT ORSLT
+8 ;
EXCLN(ORNOW) ;clean up old entires in ^XTMP("ORB LAST EXPIRE")
+1 NEW ORN,ORDT
+2 SET ORN=1
+3 FOR
SET ORN=$ORDER(^XTMP("ORB LAST EXPIRE",ORN))
if ORN=""
QUIT
Begin DoDot:1
+4 SET ORDT=$GET(^XTMP("ORB LAST EXPIRE",ORN))
+5 IF $LENGTH(ORDT)
IF (ORDT<ORNOW)
Begin DoDot:2
+6 KILL ^XTMP("ORB LAST EXPIRE",ORN)
End DoDot:2
End DoDot:1
+7 QUIT
