YSSR1 ;SLC/AFE,HIOFO/FT - SECLUSION/RESTRAINT - Observation, Release & Review ;10/21/11 10:54am
;;5.01;MENTAL HEALTH;**82,60**;Dec 30, 1994;Build 47
;
;Reference to ^DPT( supported by DBIA #10035
;
ENRLS ; Called from MENU option YSSR RELEASE
;
; Release of patient from S/R episode.
W @IOF,!?IOM-$L("RELEASE FROM SECLUSION/RESTRAINT")\2,"RELEASE FROM SECLUSION/RESTRAINT",! S OPT=1,MSG1="No patients listed as requiring release."
D LKUP^YSSR I '$D(A1) D END^YSSR Q
D ^YSLRP I YSDFN'>0 D END^YSSR Q
S DIC="^YS(615.2,",DIC(0)="X",D="AC",X=YSDFN D IX^DIC S B=+Y I B<1 W $C(7),!!,"Patient not listed as in Seclusion/Restraint." D END^YSSR Q
I $D(^YS(615.2,B,40)) S Y=+$P($G(^(40)),U,3) D DD^%DT W !!,$C(7),YSN," shown as released ",Y D END^YSSR Q
W ! S DIE="^YS(615.2,",DA=B,DR="40:41;42//NOW"
K Y L +^YS(615.2,DA):DILOCKTM
I '$T D ERRMSG^YSSITE,END^YSSR Q
D ^DIE
S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
I YSTOUT!YSUOUT L -^YS(615.2,DA) K ^YS(615.2,B,40) W !!?10,"< RELEASE DELETED >" D END^YSSR Q
S DR="43///^S X=""`""_DUZ;44///NOW;45" D ^DIE
L -^YS(615.2,DA) W !!?10,"PATIENT NOTED AS RELEASED."
D END^YSSR
Q
ENREV ; Called from MENU option YSSR REVIEW
; Review of S/R action.
W @IOF,!?IOM-$L("REVIEW OF SECLUSION/RESTRAINT ASSESSMENT")\2,"REVIEW OF SECLUSION/RESTRAINT ASSESSMENT",!
REV ;
I '$O(^YS(615.2,"AD",0)) W !!,"No review action required." D END^YSSR Q
S RVN=0,QRVN=1 W !,"The following S/R actions have not been reviewed: ",! S B=0 F S B=$O(^YS(615.2,"AD",B)) Q:'B S B1=0 F S B1=$O(^YS(615.2,"AD",B,B1)) Q:'B1 S RVN=RVN+1,RVP(RVN)=B1 D REVLST
ASK ;
W !!,"Select action for review: ",QRVN,"// " R A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" Q:YSTOUT!YSUOUT S:A1="" A1=QRVN I A1'?.N S A1=0
I A1<1!(A1>RVN) W !!,$C(7),"Not valid - re-enter." K A1 G ASK
W @IOF S (DA,FN)=RVP(A1),DIC="^YS(615.2," D EN^DIQ W !,"**********"
S DIE="^YS(615.2,",DA=FN,DR="50;51//A;52//NOW"
L +^YS(615.2,DA):DILOCKTM
I '$T D ERRMSG^YSSITE,END^YSSR Q
D ^DIE
S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
I YSTOUT!YSUOUT!($O(Y(""))]"") L -^YS(615.2,DA) K ^YS(615.2,FN,50),DA,DIE,DR W !!?10,"< REVIEW ACTION DELETED >" D END^YSSR Q
S DR="53///^S X=""`""_DUZ;54///NOW;55"
D ^DIE
W !!?10,"REVIEW ACTION NOTED." L -^YS(615.2,DA) K DA,DIE,DR
I '$D(^YS(615.2,"AD")) W !,"No other review action required." D END^YSSR Q
G REV
;
REVLST ;
S RVNM=$P(^DPT(B,0),U),Y=$P(^YS(615.2,B1,0),U,3) D DD^%DT W !?3,RVN,?8,$P(RVNM,",",2)_" "_$P(RVNM,",",1),?40,Y
Q
;
ENCK ; Called from MENU option YSSR 15-CHECK
; Observation of patient in S/R.
S YSB=0 D LKUP^YSSR G:'$D(A1) END^YSSR
D ^YSLRP I YSDFN'>0 D END^YSSR Q
S YSB=$O(^YS(615.2,"AC",YSDFN,YSB)) Q:'YSB I '$D(^YS(615.2,YSB,60)) S ^YS(615.2,YSB,60,0)="^615.3DA^^"
S DIC="^YS(615.2,YSB,60,",DIC(0)="AMELQ",DLAYGO=615.2,DIC("B")="NOW",DA(1)=YSB D ^DIC K DIC("B") I Y<1 D END^YSSR Q
S DIE=DIC,DA=+Y,DR="1;4"
L +^YS(615.2,YSB):DILOCKTM
I '$T D ERRMSG^YSSITE,END^YSSR Q
D ^DIE
S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
I YSTOUT!YSUOUT!('$P($G(^YS(615.2,DA(1),60,DA,0)),U,2))!('$O(^YS(615.2,DA(1),60,DA,60,0))) L -^YS(615.2,YSB) S DIK=DIE D ^DIK W !!?10,"< OBSERVATION DELETED >" D END^YSSR Q
S DR="2///^S X=""`""_DUZ;3///NOW"
D ^DIE
W !!?15,"OBSERVATION NOTED." L -^YS(615.2,YSB)
D END^YSSR
Q
ENWO ; Called from MENU option YSSR W-ORDER
; Entry/edit of Type of S/R Order
W @IOF,!?IOM-$L("EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER")\2,"EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER",!
W !,"SECLUSION/RESTRAINT EPISODES REQUIRING WRITTEN ORDERS: ",!
D HEADER^YSSR S A=0 F S A=$O(^YS(615.2,"AF",A)) Q:'A S A1=0 F S A1=$O(^YS(615.2,"AF",A,A1)) Q:'A1 D PNAMES^YSSR S YSWN=1,YSA1=A1
I '$D(YSWN) W !!,"No patients listed as requiring a written order.",! D END^YSSR Q
I $D(YS02) W !!," * Written Order Required.",!
I $D(YS04) W:'$D(YS02) !! W " # Record incomplete, please contact IRM.",!
K YS02,YS04
D ^YSLRP I YSDFN'>0 D END^YSSR Q
WOLKUP ;
S YSA1=$O(^YS(615.2,"AF",YSDFN,0)) I 'YSA1 W !!,"Written order not required for this patient.",! D END^YSSR Q
S DIE="^YS(615.2,",DA=YSA1,DR="25:27;28///NOW"
L +^YS(615.2,YSA1):DILOCKTM
I '$T D ERRMSG^YSSITE,END^YSSR Q
D ^DIE L -^YS(615.2,YSA1)
I $P(^YS(615.2,YSA1,25),U,2)="w" K ^YS(615.2,"AF",YSDFN,YSA1)
D END^YSSR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSSR1 4307 printed Apr 09, 2024@21:23:11 Page 2
YSSR1 ;SLC/AFE,HIOFO/FT - SECLUSION/RESTRAINT - Observation, Release & Review ;10/21/11 10:54am
+1 ;;5.01;MENTAL HEALTH;**82,60**;Dec 30, 1994;Build 47
+2 ;
+3 ;Reference to ^DPT( supported by DBIA #10035
+4 ;
ENRLS ; Called from MENU option YSSR RELEASE
+1 ;
+2 ; Release of patient from S/R episode.
+3 WRITE @IOF,!?IOM-$LENGTH("RELEASE FROM SECLUSION/RESTRAINT")\2,"RELEASE FROM SECLUSION/RESTRAINT",!
SET OPT=1
SET MSG1="No patients listed as requiring release."
+4 DO LKUP^YSSR
IF '$DATA(A1)
DO END^YSSR
QUIT
+5 DO ^YSLRP
IF YSDFN'>0
DO END^YSSR
QUIT
+6 SET DIC="^YS(615.2,"
SET DIC(0)="X"
SET D="AC"
SET X=YSDFN
DO IX^DIC
SET B=+Y
IF B<1
WRITE $CHAR(7),!!,"Patient not listed as in Seclusion/Restraint."
DO END^YSSR
QUIT
+7 IF $DATA(^YS(615.2,B,40))
SET Y=+$PIECE($GET(^(40)),U,3)
DO DD^%DT
WRITE !!,$CHAR(7),YSN," shown as released ",Y
DO END^YSSR
QUIT
+8 WRITE !
SET DIE="^YS(615.2,"
SET DA=B
SET DR="40:41;42//NOW"
+9 KILL Y
LOCK +^YS(615.2,DA):DILOCKTM
+10 IF '$TEST
DO ERRMSG^YSSITE
DO END^YSSR
QUIT
+11 DO ^DIE
+12 SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$ORDER(Y(""))]""
+13 IF YSTOUT!YSUOUT
LOCK -^YS(615.2,DA)
KILL ^YS(615.2,B,40)
WRITE !!?10,"< RELEASE DELETED >"
DO END^YSSR
QUIT
+14 SET DR="43///^S X=""`""_DUZ;44///NOW;45"
DO ^DIE
+15 LOCK -^YS(615.2,DA)
WRITE !!?10,"PATIENT NOTED AS RELEASED."
+16 DO END^YSSR
+17 QUIT
ENREV ; Called from MENU option YSSR REVIEW
+1 ; Review of S/R action.
+2 WRITE @IOF,!?IOM-$LENGTH("REVIEW OF SECLUSION/RESTRAINT ASSESSMENT")\2,"REVIEW OF SECLUSION/RESTRAINT ASSESSMENT",!
REV ;
+1 IF '$ORDER(^YS(615.2,"AD",0))
WRITE !!,"No review action required."
DO END^YSSR
QUIT
+2 SET RVN=0
SET QRVN=1
WRITE !,"The following S/R actions have not been reviewed: ",!
SET B=0
FOR
SET B=$ORDER(^YS(615.2,"AD",B))
if 'B
QUIT
SET B1=0
FOR
SET B1=$ORDER(^YS(615.2,"AD",B,B1))
if 'B1
QUIT
SET RVN=RVN+1
SET RVP(RVN)=B1
DO REVLST
ASK ;
+1 WRITE !!,"Select action for review: ",QRVN,"// "
READ A1:DTIME
SET YSTOUT='$TEST
SET YSUOUT=A1["^"
if YSTOUT!YSUOUT
QUIT
if A1=""
SET A1=QRVN
IF A1'?.N
SET A1=0
+2 IF A1<1!(A1>RVN)
WRITE !!,$CHAR(7),"Not valid - re-enter."
KILL A1
GOTO ASK
+3 WRITE @IOF
SET (DA,FN)=RVP(A1)
SET DIC="^YS(615.2,"
DO EN^DIQ
WRITE !,"**********"
+4 SET DIE="^YS(615.2,"
SET DA=FN
SET DR="50;51//A;52//NOW"
+5 LOCK +^YS(615.2,DA):DILOCKTM
+6 IF '$TEST
DO ERRMSG^YSSITE
DO END^YSSR
QUIT
+7 DO ^DIE
+8 SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
+9 IF YSTOUT!YSUOUT!($ORDER(Y(""))]"")
LOCK -^YS(615.2,DA)
KILL ^YS(615.2,FN,50),DA,DIE,DR
WRITE !!?10,"< REVIEW ACTION DELETED >"
DO END^YSSR
QUIT
+10 SET DR="53///^S X=""`""_DUZ;54///NOW;55"
+11 DO ^DIE
+12 WRITE !!?10,"REVIEW ACTION NOTED."
LOCK -^YS(615.2,DA)
KILL DA,DIE,DR
+13 IF '$DATA(^YS(615.2,"AD"))
WRITE !,"No other review action required."
DO END^YSSR
QUIT
+14 GOTO REV
+15 ;
REVLST ;
+1 SET RVNM=$PIECE(^DPT(B,0),U)
SET Y=$PIECE(^YS(615.2,B1,0),U,3)
DO DD^%DT
WRITE !?3,RVN,?8,$PIECE(RVNM,",",2)_" "_$PIECE(RVNM,",",1),?40,Y
+2 QUIT
+3 ;
ENCK ; Called from MENU option YSSR 15-CHECK
+1 ; Observation of patient in S/R.
+2 SET YSB=0
DO LKUP^YSSR
if '$DATA(A1)
GOTO END^YSSR
+3 DO ^YSLRP
IF YSDFN'>0
DO END^YSSR
QUIT
+4 SET YSB=$ORDER(^YS(615.2,"AC",YSDFN,YSB))
if 'YSB
QUIT
IF '$DATA(^YS(615.2,YSB,60))
SET ^YS(615.2,YSB,60,0)="^615.3DA^^"
+5 SET DIC="^YS(615.2,YSB,60,"
SET DIC(0)="AMELQ"
SET DLAYGO=615.2
SET DIC("B")="NOW"
SET DA(1)=YSB
DO ^DIC
KILL DIC("B")
IF Y<1
DO END^YSSR
QUIT
+6 SET DIE=DIC
SET DA=+Y
SET DR="1;4"
+7 LOCK +^YS(615.2,YSB):DILOCKTM
+8 IF '$TEST
DO ERRMSG^YSSITE
DO END^YSSR
QUIT
+9 DO ^DIE
+10 SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
+11 IF YSTOUT!YSUOUT!('$PIECE($GET(^YS(615.2,DA(1),60,DA,0)),U,2))!('$ORDER(^YS(615.2,DA(1),60,DA,60,0)))
LOCK -^YS(615.2,YSB)
SET DIK=DIE
DO ^DIK
WRITE !!?10,"< OBSERVATION DELETED >"
DO END^YSSR
QUIT
+12 SET DR="2///^S X=""`""_DUZ;3///NOW"
+13 DO ^DIE
+14 WRITE !!?15,"OBSERVATION NOTED."
LOCK -^YS(615.2,YSB)
+15 DO END^YSSR
+16 QUIT
ENWO ; Called from MENU option YSSR W-ORDER
+1 ; Entry/edit of Type of S/R Order
+2 WRITE @IOF,!?IOM-$LENGTH("EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER")\2,"EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER",!
+3 WRITE !,"SECLUSION/RESTRAINT EPISODES REQUIRING WRITTEN ORDERS: ",!
+4 DO HEADER^YSSR
SET A=0
FOR
SET A=$ORDER(^YS(615.2,"AF",A))
if 'A
QUIT
SET A1=0
FOR
SET A1=$ORDER(^YS(615.2,"AF",A,A1))
if 'A1
QUIT
DO PNAMES^YSSR
SET YSWN=1
SET YSA1=A1
+5 IF '$DATA(YSWN)
WRITE !!,"No patients listed as requiring a written order.",!
DO END^YSSR
QUIT
+6 IF $DATA(YS02)
WRITE !!," * Written Order Required.",!
+7 IF $DATA(YS04)
if '$DATA(YS02)
WRITE !!
WRITE " # Record incomplete, please contact IRM.",!
+8 KILL YS02,YS04
+9 DO ^YSLRP
IF YSDFN'>0
DO END^YSSR
QUIT
WOLKUP ;
+1 SET YSA1=$ORDER(^YS(615.2,"AF",YSDFN,0))
IF 'YSA1
WRITE !!,"Written order not required for this patient.",!
DO END^YSSR
QUIT
+2 SET DIE="^YS(615.2,"
SET DA=YSA1
SET DR="25:27;28///NOW"
+3 LOCK +^YS(615.2,YSA1):DILOCKTM
+4 IF '$TEST
DO ERRMSG^YSSITE
DO END^YSSR
QUIT
+5 DO ^DIE
LOCK -^YS(615.2,YSA1)
+6 IF $PIECE(^YS(615.2,YSA1,25),U,2)="w"
KILL ^YS(615.2,"AF",YSDFN,YSA1)
+7 DO END^YSSR
+8 QUIT
