- 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 Dec 13, 2024@02:14:59 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 ;