- ORWTPUA ;SLC/STAFF Personal Preference - Utility Alerts ;Jul 19, 2021@12:39:02
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,243,296,539,405**;Oct 24, 2000;Build 211
- ;
- START(USER) ; $$(user) -> user's surrogate start date/time
- Q $P($G(^XTV(8992,+$G(USER),0)),U,3)
- ;
- STOP(USER) ; $$(user) -> user's surrogate stop date/time
- Q $P($G(^XTV(8992,+$G(USER),0)),U,4)
- ;
- CHKSURR(USER,SURR) ; $$(user,surrogate) -> 1 if ok else 0^reason for reject
- N OK,START
- S USER=+$G(USER),SURR=+$G(SURR)
- I USER=SURR Q "0^You cannot specify yourself as your own surrogate!"
- S START=$$GET1^DIQ(8992,(SURR_","),.02,"I")
- I START<.5 Q 1
- I START=USER Q "0^You are designated as the surrogate for this user - can't do it!"
- S OK=1 F S START=$$GET1^DIQ(8992,(START_","),.02,"I") Q:START'>0 I START=USER S OK=0 Q
- I 'OK Q "0^This forms a circle which leads back to you - can't do it!"
- Q 1
- ;
- CHKSURRO(USER,SURR,START,STOP) ; Check if surrogate has a surrogate
- ; designated for same time period
- N OK,RSLT,SURSTOP,SURSTRT,X
- S OK=1
- I +STOP=0 S STOP=9999999
- I +START>0 D
- . D GETSURRS^ORWTPR(.RSLT,SURR)
- . I RSLT>0 D
- .. S X=0
- .. F S X=$O(RSLT(X)) Q:X="" D Q:+OK=0
- ... S SURSTRT=$P(RSLT(X),U,3)
- ... S SURSTOP=$P(RSLT(X),U,4)
- ... I +SURSTOP=0 S SURSTOP=9999999
- ... I START<=SURSTRT,STOP>=SURSTOP S OK=0 Q
- ... I START>SURSTRT,START<SURSTOP S OK=0 Q
- ... I STOP>SURSTRT,STOP<SURSTOP S OK=0 Q
- .. I OK=0 S OK="0^"_$S(+SURR>0:$P($G(^VA(200,SURR,0)),U,1),1:SURR)_" has a surrogate scheduled during the same time period of "_$$FMTE^XLFDT(SURSTRT,5)_$S(SURSTOP'=9999999:" through "_$$FMTE^XLFDT(SURSTOP,5),1:" with no end date")_"!"
- Q OK
- ;
- GETSURR(USER) ; $$(user ien) -> surrogate ien
- Q $$CURRSURO^XQALSURO(+$G(USER))
- ;
- SAVESURR(USER,SURR,START,STOP) ; save user's surrogate info
- N RET
- S STOP=$G(STOP)
- ;D REMVSURO^XQALSURO(USER,$S(SURR=-1:"",1:SURR),$S(START>0:START,1:"")) Q:((SURR=-1)!(STOP=0)) 1
- I (STOP=0)!(SURR=-1) D REMVSURO^XQALSURO(USER,$S(SURR=-1:"",1:SURR),$S(START>0:START,1:"")) Q 1
- S RET=$$SETSURO1^XQALSURO(USER,SURR,START,STOP)
- Q RET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWTPUA 2090 printed Feb 19, 2025@00:04:11 Page 2
- ORWTPUA ;SLC/STAFF Personal Preference - Utility Alerts ;Jul 19, 2021@12:39:02
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,243,296,539,405**;Oct 24, 2000;Build 211
- +2 ;
- START(USER) ; $$(user) -> user's surrogate start date/time
- +1 QUIT $PIECE($GET(^XTV(8992,+$GET(USER),0)),U,3)
- +2 ;
- STOP(USER) ; $$(user) -> user's surrogate stop date/time
- +1 QUIT $PIECE($GET(^XTV(8992,+$GET(USER),0)),U,4)
- +2 ;
- CHKSURR(USER,SURR) ; $$(user,surrogate) -> 1 if ok else 0^reason for reject
- +1 NEW OK,START
- +2 SET USER=+$GET(USER)
- SET SURR=+$GET(SURR)
- +3 IF USER=SURR
- QUIT "0^You cannot specify yourself as your own surrogate!"
- +4 SET START=$$GET1^DIQ(8992,(SURR_","),.02,"I")
- +5 IF START<.5
- QUIT 1
- +6 IF START=USER
- QUIT "0^You are designated as the surrogate for this user - can't do it!"
- +7 SET OK=1
- FOR
- SET START=$$GET1^DIQ(8992,(START_","),.02,"I")
- if START'>0
- QUIT
- IF START=USER
- SET OK=0
- QUIT
- +8 IF 'OK
- QUIT "0^This forms a circle which leads back to you - can't do it!"
- +9 QUIT 1
- +10 ;
- CHKSURRO(USER,SURR,START,STOP) ; Check if surrogate has a surrogate
- +1 ; designated for same time period
- +2 NEW OK,RSLT,SURSTOP,SURSTRT,X
- +3 SET OK=1
- +4 IF +STOP=0
- SET STOP=9999999
- +5 IF +START>0
- Begin DoDot:1
- +6 DO GETSURRS^ORWTPR(.RSLT,SURR)
- +7 IF RSLT>0
- Begin DoDot:2
- +8 SET X=0
- +9 FOR
- SET X=$ORDER(RSLT(X))
- if X=""
- QUIT
- Begin DoDot:3
- +10 SET SURSTRT=$PIECE(RSLT(X),U,3)
- +11 SET SURSTOP=$PIECE(RSLT(X),U,4)
- +12 IF +SURSTOP=0
- SET SURSTOP=9999999
- +13 IF START<=SURSTRT
- IF STOP>=SURSTOP
- SET OK=0
- QUIT
- +14 IF START>SURSTRT
- IF START<SURSTOP
- SET OK=0
- QUIT
- +15 IF STOP>SURSTRT
- IF STOP<SURSTOP
- SET OK=0
- QUIT
- End DoDot:3
- if +OK=0
- QUIT
- +16 IF OK=0
- SET OK="0^"_$SELECT(+SURR>0:$PIECE($GET(^VA(200,SURR,0)),U,1),1:SURR)_" has a surrogate scheduled during the same time period of "_$$FMTE^XLFDT(SURSTRT,5)_$SELECT(SURSTOP'=9999999:" through "_$$FMTE^XLFDT(SURSTOP,5),1:" with
- no end date")_"!"
- End DoDot:2
- End DoDot:1
- +17 QUIT OK
- +18 ;
- GETSURR(USER) ; $$(user ien) -> surrogate ien
- +1 QUIT $$CURRSURO^XQALSURO(+$GET(USER))
- +2 ;
- SAVESURR(USER,SURR,START,STOP) ; save user's surrogate info
- +1 NEW RET
- +2 SET STOP=$GET(STOP)
- +3 ;D REMVSURO^XQALSURO(USER,$S(SURR=-1:"",1:SURR),$S(START>0:START,1:"")) Q:((SURR=-1)!(STOP=0)) 1
- +4 IF (STOP=0)!(SURR=-1)
- DO REMVSURO^XQALSURO(USER,$SELECT(SURR=-1:"",1:SURR),$SELECT(START>0:START,1:""))
- QUIT 1
- +5 SET RET=$$SETSURO1^XQALSURO(USER,SURR,START,STOP)
- +6 QUIT RET