YSSRU1 ;DALISC/LJA - Seclusion/Restraint Utility Code ;08/13/93 11:21
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
PWARN ; Warn user of danger of editing pointer entries
N EX,I,OPT,T,TXT
;
; General warning
W @IOF
S TXT="HD" D DISPLAY
S TXT="GWARN" D DISPLAY
;
; Find option name
QUIT:$G(XQY)'>0 ;-> Don't know which option it is...
S DIC=19,DIQ="OPT",DIQ(0)="E",DA=+XQY,DR=1 D EN^DIQ1
S OPT=$$UP^XLFSTR($G(OPT(19,+DA,1,"E")))
S EX=$S(OPT["REASONS":"REAEX",OPT["CATEGORY":"CATEX",OPT["RELEASE":"RELEX",OPT["ALTERNATIVES":"ALTEX",OPT["CHECKLIST":"CHKEX",1:"")
I EX']"" S TXT="HD" D DISPLAY QUIT ;->
;
; Specific example
S TXT=EX W ! D DISPLAY
S TXT="HD" D DISPLAY
QUIT
;
HD ;
;;
;; ---------------------------------------------------------
;; !! W A R N I N G !!
;; ---------------------------------------------------------
;;
;
GWARN ;
;; You may edit the name of the file entry, but do NOT change it's meaning!
;
REAEX ; S/R Reasons example
;; For example, "disrupting therapeutic milieu" can be changed to "disruption
;; of therepeutic milieu". However, "disrupting therapeutic milieu" should
;; NOT be changed to "harm to family"!
;
CATEX ; S/R Category example
;; For example, "Velcro Restraints" can be changed to "VELCRO RESTRAINTS".
;; However, "Velcro Restraints" should NOT be changed to "UNLOCKED SECLUSION"!
;
RELEX ; S/R Release example
;; For example, "DISRUPTING BEHAVIOR CEASED" can be changed to "DISRUPTING
;; BEHAVIOR STOPPED". However, "DISRUPTING BEHAVIOR CEASED" should NOT be
;; changed to "CESSATION OF HARM TO OTHERS"!
;
ALTEX ; S/R Alternatives example
;; For example, "RELAXATION TECHNIQUES" can be changed to "RELAXATION
;; METHODS". However, "RELAXATION TECHNIQUES" should NOT be changed to
;; "PROBLEM RESOLUTION"!
;
CHKEX ; S/R Check list example
;; For example, "BEATING ON DOOR" can be changed to "BEATING ON DOOR OR WALL".
;; However, "BEATING ON DOOR" should NOT be changed to "CURSING"!
;
DISPLAY ; Display text...
QUIT:$G(TXT)']"" ;->
N I,T F I=1:1 S T=$T(@TXT+I) Q:T'[";;" S T=$P(T,";;",2,99) W !,T
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSSRU1 2231 printed Oct 16, 2024@18:15:42 Page 2
YSSRU1 ;DALISC/LJA - Seclusion/Restraint Utility Code ;08/13/93 11:21
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
PWARN ; Warn user of danger of editing pointer entries
+1 NEW EX,I,OPT,T,TXT
+2 ;
+3 ; General warning
+4 WRITE @IOF
+5 SET TXT="HD"
DO DISPLAY
+6 SET TXT="GWARN"
DO DISPLAY
+7 ;
+8 ; Find option name
+9 ;-> Don't know which option it is...
if $GET(XQY)'>0
QUIT
+10 SET DIC=19
SET DIQ="OPT"
SET DIQ(0)="E"
SET DA=+XQY
SET DR=1
DO EN^DIQ1
+11 SET OPT=$$UP^XLFSTR($GET(OPT(19,+DA,1,"E")))
+12 SET EX=$SELECT(OPT["REASONS":"REAEX",OPT["CATEGORY":"CATEX",OPT["RELEASE":"RELEX",OPT["ALTERNATIVES":"ALTEX",OPT["CHECKLIST":"CHKEX",1:"")
+13 ;->
IF EX']""
SET TXT="HD"
DO DISPLAY
QUIT
+14 ;
+15 ; Specific example
+16 SET TXT=EX
WRITE !
DO DISPLAY
+17 SET TXT="HD"
DO DISPLAY
+18 QUIT
+19 ;
HD ;
+1 ;;
+2 ;; ---------------------------------------------------------
+3 ;; !! W A R N I N G !!
+4 ;; ---------------------------------------------------------
+5 ;;
+6 ;
GWARN ;
+1 ;; You may edit the name of the file entry, but do NOT change it's meaning!
+2 ;
REAEX ; S/R Reasons example
+1 ;; For example, "disrupting therapeutic milieu" can be changed to "disruption
+2 ;; of therepeutic milieu". However, "disrupting therapeutic milieu" should
+3 ;; NOT be changed to "harm to family"!
+4 ;
CATEX ; S/R Category example
+1 ;; For example, "Velcro Restraints" can be changed to "VELCRO RESTRAINTS".
+2 ;; However, "Velcro Restraints" should NOT be changed to "UNLOCKED SECLUSION"!
+3 ;
RELEX ; S/R Release example
+1 ;; For example, "DISRUPTING BEHAVIOR CEASED" can be changed to "DISRUPTING
+2 ;; BEHAVIOR STOPPED". However, "DISRUPTING BEHAVIOR CEASED" should NOT be
+3 ;; changed to "CESSATION OF HARM TO OTHERS"!
+4 ;
ALTEX ; S/R Alternatives example
+1 ;; For example, "RELAXATION TECHNIQUES" can be changed to "RELAXATION
+2 ;; METHODS". However, "RELAXATION TECHNIQUES" should NOT be changed to
+3 ;; "PROBLEM RESOLUTION"!
+4 ;
CHKEX ; S/R Check list example
+1 ;; For example, "BEATING ON DOOR" can be changed to "BEATING ON DOOR OR WALL".
+2 ;; However, "BEATING ON DOOR" should NOT be changed to "CURSING"!
+3 ;
DISPLAY ; Display text...
+1 ;->
if $GET(TXT)']""
QUIT
+2 NEW I,T
FOR I=1:1
SET T=$TEXT(@TXT+I)
if T'[";;"
QUIT
SET T=$PIECE(T,";;",2,99)
WRITE !,T
+3 QUIT
+4 ;
