- 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 Feb 18, 2025@23:54:05 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